<!DOCTYPE html>
<html lang="en">
  <head>
    <meta charset="utf-8">
    <meta http-equiv="X-UA-Compatible" content="IE=edge">
    <meta name="viewport" content="width=device-width, initial-scale=1">
   
   <meta name="description" content="command line parsing">
    
    <meta name="author" content="John S. Urban" >
    <link rel="icon" href="../favicon.png">

    <title>M_CLI2.F90 &ndash; M_CLI2</title>

    <link href="../css/bootstrap.min.css" rel="stylesheet">
    <link href="../css/pygments.css" rel="stylesheet">
    <link href="../css/font-awesome.min.css" rel="stylesheet">
    <link href="../css/local.css" rel="stylesheet">
    
    <link  href="../tipuesearch/tipuesearch.css" rel="stylesheet">
    
    

    <!-- HTML5 shim and Respond.js for IE8 support of HTML5 elements and media queries -->
    <!--[if lt IE 9]>
      <script src="https://oss.maxcdn.com/html5shiv/3.7.2/html5shiv.min.js"></script>
      <script src="https://oss.maxcdn.com/respond/1.4.2/respond.min.js"></script>
    <![endif]-->
    
    <script src="../js/jquery-2.1.3.min.js"></script>
    <script src="../js/svg-pan-zoom.min.js"></script>

  </head>

  <body>

    <!-- Fixed navbar -->
    <nav class="navbar navbar-inverse navbar-fixed-top">
      <div class="container">
        <div class="navbar-header">
          <button type="button" class="navbar-toggle collapsed" data-toggle="collapse" data-target="#navbar" aria-expanded="false" aria-controls="navbar">
            <span class="sr-only">Toggle navigation</span>
            <span class="icon-bar"></span>
            <span class="icon-bar"></span>
            <span class="icon-bar"></span>
          </button>
          <a class="navbar-brand" href="../index.html">M_CLI2 </a>
        </div>
        <div id="navbar" class="navbar-collapse collapse">
          <ul class="nav navbar-nav">
        
            <li class="dropdown hidden-xs visible-sm visible-md hidden-lg">
              <a href="#" class="dropdown-toggle"
              data-toggle="dropdown" role="button"
              aria-haspopup="true"
     aria-expanded="false">Contents <span class="caret"></span></a>
        <ul class="dropdown-menu">
          
              
            <li><a href="../lists/files.html">Source Files</a></li>
        
        
        
            <li><a href="../lists/modules.html">Modules</a></li>
        
            
                                
            <li><a href="../lists/procedures.html">Procedures</a></li>
        
               
            <li><a href="../lists/types.html">Derived Types</a></li>
        
        
            <li><a href="../lists/programs.html">Programs</a></li>
        
            </ul>
            </li>


<li class="visible-xs hidden-sm visible-lg"><a href="../lists/files.html">Source Files</a></li>



<li class="visible-xs hidden-sm visible-lg"><a href="../lists/modules.html">Modules</a></li>



<li class="visible-xs hidden-sm visible-lg"><a href="../lists/procedures.html">Procedures</a></li>

                             
<li class="visible-xs hidden-sm visible-lg"><a href="../lists/types.html">Derived Types</a></li>


<li class="visible-xs hidden-sm visible-lg"><a href="../lists/programs.html">Programs</a></li>

          </ul>
        
        <form action="../search.html" class="navbar-form navbar-right" role="search">
        <div class="form-group">
          <input type="text" class="form-control" placeholder="Search" name="q" id="tipue_search_input" autocomplete="off" required>
        </div>
<!--
        <button type="submit" class="btn btn-default">Submit</button>
-->
        </form>
        
        </div><!--/.nav-collapse -->
      </div>
    </nav>

    <div class="container">
    
  
  <div class="row">
    <h1>M_CLI2.F90
    <small>Source File</small>
    
    </h1>
    
<div class="row">
  <div class="col-lg-12">
<div class="well well-sm">
  <ul class="list-inline" style="margin-bottom:0px;display:inline">
     
     
     
     
    
    
     <li><i class="fa fa-list-ol"></i>
       <a data-toggle="tooltip"
    data-placement="bottom" data-html="true"
    title="82.6% of total for source files.">3057 statements</a>
     </li> 
     
     
     
    <li><i class="fa fa-code"></i><a href="../src/M_CLI2.F90"> Source File</a></li>
     
     
  </ul>
  <ol class="breadcrumb in-well text-right">
  
    
  
     <li class="active">M_CLI2.F90</li>
  </ol>
</div>
</div>
</div>
<script>
  $(function () {
  $('[data-toggle="tooltip"]').tooltip()
  })
</script>

  </div>
  <div class="row">
    <div class="col-md-3 hidden-xs hidden-sm visible-md visible-lg">
    
<div id="sidebar">
  
<h3>Contents</h3>
 







<div class="panel panel-primary">
  <div class="panel-heading text-left"><h3 class="panel-title"><a data-toggle="collapse" href="#mods-0">Modules</a></h3></div>
  <div id="mods-0" class="panel-collapse collapse">
    <div class="list-group">
      
      <a class="list-group-item" href="../module/m_cli2.html">M_CLI2</a>
      
    </div>
  </div>
</div>
















<div class="panel panel-primary">
  <div class="panel-heading text-left"><h3 class="panel-title">Source Code</h3></div>
  <div class="list-group">
    <a class="list-group-item" href="../sourcefile/m_cli2.f90.html#src">M_CLI2.F90</a>
  </div>
</div>



</div>

    </div>
    <div class="col-md-9" id='text'>
      
      <br>
    
      
      

    <section class="visible-xs visible-sm hidden-md">
      
<h3>Contents</h3>
 







<div class="panel panel-primary">
  <div class="panel-heading text-left"><h3 class="panel-title"><a data-toggle="collapse" href="#mods-1">Modules</a></h3></div>
  <div id="mods-1" class="panel-collapse collapse">
    <div class="list-group">
      
      <a class="list-group-item" href="../module/m_cli2.html">M_CLI2</a>
      
    </div>
  </div>
</div>
















<div class="panel panel-primary">
  <div class="panel-heading text-left"><h3 class="panel-title">Source Code</h3></div>
  <div class="list-group">
    <a class="list-group-item" href="../sourcefile/m_cli2.f90.html#src">M_CLI2.F90</a>
  </div>
</div>



    </section>
    <br class="visible-xs visible-sm hidden-md">

    <section>
      <h2><span class="anchor" id="src"></span>Source Code</h2>
    <div class="hl"><pre><span></span><a name="ln-1"></a><span class="c">!VERSION 1.0 20200115</span>
<a name="ln-2"></a><span class="c">!VERSION 2.0 20200802</span>
<a name="ln-3"></a><span class="c">!VERSION 3.0 20201021  LONG:SHORT syntax</span>
<a name="ln-4"></a><span class="c">!VERSION 3.1 20201115  LONG:SHORT:: syntax</span>
<a name="ln-5"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-6"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-7"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-8"></a><span class="c">!&gt;</span>
<a name="ln-9"></a><span class="c">!!##NAME</span>
<a name="ln-10"></a><span class="c">!!     M_CLI2(3fm) - [ARGUMENTS::M_CLI2::INTRO] - command line argument</span>
<a name="ln-11"></a><span class="c">!!     parsing using a prototype command</span>
<a name="ln-12"></a><span class="c">!!     (LICENSE:PD)</span>
<a name="ln-13"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-14"></a><span class="c">!!</span>
<a name="ln-15"></a><span class="c">!!   Available procedures and variables:</span>
<a name="ln-16"></a><span class="c">!!</span>
<a name="ln-17"></a><span class="c">!!      use M_CLI2, only : set_args, get_args, unnamed, remaining, args</span>
<a name="ln-18"></a><span class="c">!!      use M_CLI2, only : get_args_fixed_length, get_args_fixed_size</span>
<a name="ln-19"></a><span class="c">!!      use M_CLI2, only : specified</span>
<a name="ln-20"></a><span class="c">!!      ! convenience functions</span>
<a name="ln-21"></a><span class="c">!!      use M_CLI2, only : dget, iget, lget, rget, sget, cget</span>
<a name="ln-22"></a><span class="c">!!      use M_CLI2, only : dgets, igets, lgets, rgets, sgets, cgets</span>
<a name="ln-23"></a><span class="c">!!</span>
<a name="ln-24"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-25"></a><span class="c">!!    Allow for command line parsing much like standard Unix command line</span>
<a name="ln-26"></a><span class="c">!!    parsing using a simple prototype.</span>
<a name="ln-27"></a><span class="c">!!</span>
<a name="ln-28"></a><span class="c">!!    Typically one call to SET_ARGS(3f) is made to define the command</span>
<a name="ln-29"></a><span class="c">!!    arguments, set default values and parse the command line. Then a call</span>
<a name="ln-30"></a><span class="c">!!    is made to the convenience commands based on GET_ARGS(3f) for each</span>
<a name="ln-31"></a><span class="c">!!    command keyword to obtain the argument values.</span>
<a name="ln-32"></a><span class="c">!!</span>
<a name="ln-33"></a><span class="c">!!    The documentation for SET_ARGS(3f) and GET_ARGS(3f) provides further</span>
<a name="ln-34"></a><span class="c">!!    details.</span>
<a name="ln-35"></a><span class="c">!!</span>
<a name="ln-36"></a><span class="c">!!##EXAMPLE</span>
<a name="ln-37"></a><span class="c">!!</span>
<a name="ln-38"></a><span class="c">!! Sample program using type conversion routines</span>
<a name="ln-39"></a><span class="c">!!</span>
<a name="ln-40"></a><span class="c">!!     program demo_M_CLI2</span>
<a name="ln-41"></a><span class="c">!!     use M_CLI2,  only : set_args, get_args</span>
<a name="ln-42"></a><span class="c">!!     use M_CLI2,  only : filenames=&gt;unnamed</span>
<a name="ln-43"></a><span class="c">!!     use M_CLI2,  only : get_args_fixed_length, get_args_fixed_size</span>
<a name="ln-44"></a><span class="c">!!     implicit none</span>
<a name="ln-45"></a><span class="c">!!     integer                      :: i</span>
<a name="ln-46"></a><span class="c">!!     integer,parameter            :: dp=kind(0.0d0)</span>
<a name="ln-47"></a><span class="c">!!     !</span>
<a name="ln-48"></a><span class="c">!!     ! DEFINE ARGS</span>
<a name="ln-49"></a><span class="c">!!     real                         :: x, y, z</span>
<a name="ln-50"></a><span class="c">!!     real(kind=dp),allocatable    :: point(:)</span>
<a name="ln-51"></a><span class="c">!!     logical                      :: l, lbig</span>
<a name="ln-52"></a><span class="c">!!     logical,allocatable          :: logicals(:)</span>
<a name="ln-53"></a><span class="c">!!     character(len=:),allocatable :: title    ! VARIABLE LENGTH</span>
<a name="ln-54"></a><span class="c">!!     character(len=40)            :: label    ! FIXED LENGTH</span>
<a name="ln-55"></a><span class="c">!!     real                         :: p(3)     ! FIXED SIZE</span>
<a name="ln-56"></a><span class="c">!!     logical                      :: logi(3)  ! FIXED SIZE</span>
<a name="ln-57"></a><span class="c">!!     !</span>
<a name="ln-58"></a><span class="c">!!     ! DEFINE AND PARSE (TO SET INITIAL VALUES) COMMAND LINE</span>
<a name="ln-59"></a><span class="c">!!     !   o set a value for all keywords.</span>
<a name="ln-60"></a><span class="c">!!     !   o double-quote strings</span>
<a name="ln-61"></a><span class="c">!!     !   o set all logical values to F or T.</span>
<a name="ln-62"></a><span class="c">!!     !   o value delimiter is comma, colon, or space</span>
<a name="ln-63"></a><span class="c">!!     call set_args(&#39;                         &amp;</span>
<a name="ln-64"></a><span class="c">!!             &amp; -x 1 -y 2 -z 3                &amp;</span>
<a name="ln-65"></a><span class="c">!!             &amp; -p -1 -2 -3                   &amp;</span>
<a name="ln-66"></a><span class="c">!!             &amp; --point 11.11, 22.22, 33.33e0 &amp;</span>
<a name="ln-67"></a><span class="c">!!             &amp; --title &quot;my title&quot; -l F -L F  &amp;</span>
<a name="ln-68"></a><span class="c">!!             &amp; --logicals  F F F F F         &amp;</span>
<a name="ln-69"></a><span class="c">!!             &amp; -logi F T F                   &amp;</span>
<a name="ln-70"></a><span class="c">!!             &amp; --label &quot; &quot; &amp;</span>
<a name="ln-71"></a><span class="c">!!             ! note space between quotes is required</span>
<a name="ln-72"></a><span class="c">!!             &amp; &#39;)</span>
<a name="ln-73"></a><span class="c">!!     ! ASSIGN VALUES TO ELEMENTS</span>
<a name="ln-74"></a><span class="c">!!     call get_args(&#39;x&#39;,x)         ! SCALARS</span>
<a name="ln-75"></a><span class="c">!!     call get_args(&#39;y&#39;,y)</span>
<a name="ln-76"></a><span class="c">!!     call get_args(&#39;z&#39;,z)</span>
<a name="ln-77"></a><span class="c">!!     call get_args(&#39;l&#39;,l)</span>
<a name="ln-78"></a><span class="c">!!     call get_args(&#39;L&#39;,lbig)</span>
<a name="ln-79"></a><span class="c">!!     call get_args(&#39;title&#39;,title) ! ALLOCATABLE STRING</span>
<a name="ln-80"></a><span class="c">!!     call get_args(&#39;point&#39;,point) ! ALLOCATABLE ARRAYS</span>
<a name="ln-81"></a><span class="c">!!     call get_args(&#39;logicals&#39;,logicals)</span>
<a name="ln-82"></a><span class="c">!!     !</span>
<a name="ln-83"></a><span class="c">!!     ! for NON-ALLOCATABLE VARIABLES</span>
<a name="ln-84"></a><span class="c">!!</span>
<a name="ln-85"></a><span class="c">!!     ! for non-allocatable string</span>
<a name="ln-86"></a><span class="c">!!     call get_args_fixed_length(&#39;label&#39;,label)</span>
<a name="ln-87"></a><span class="c">!!</span>
<a name="ln-88"></a><span class="c">!!     ! for non-allocatable arrays</span>
<a name="ln-89"></a><span class="c">!!     call get_args_fixed_size(&#39;p&#39;,p)</span>
<a name="ln-90"></a><span class="c">!!     call get_args_fixed_size(&#39;logi&#39;,logi)</span>
<a name="ln-91"></a><span class="c">!!     !</span>
<a name="ln-92"></a><span class="c">!!     ! USE VALUES</span>
<a name="ln-93"></a><span class="c">!!     write(*,*)&#39;x=&#39;,x, &#39;y=&#39;,y, &#39;z=&#39;,z, x+y+z</span>
<a name="ln-94"></a><span class="c">!!     write(*,*)&#39;p=&#39;,p</span>
<a name="ln-95"></a><span class="c">!!     write(*,*)&#39;point=&#39;,point</span>
<a name="ln-96"></a><span class="c">!!     write(*,*)&#39;title=&#39;,title</span>
<a name="ln-97"></a><span class="c">!!     write(*,*)&#39;label=&#39;,label</span>
<a name="ln-98"></a><span class="c">!!     write(*,*)&#39;l=&#39;,l</span>
<a name="ln-99"></a><span class="c">!!     write(*,*)&#39;L=&#39;,lbig</span>
<a name="ln-100"></a><span class="c">!!     write(*,*)&#39;logicals=&#39;,logicals</span>
<a name="ln-101"></a><span class="c">!!     write(*,*)&#39;logi=&#39;,logi</span>
<a name="ln-102"></a><span class="c">!!     !</span>
<a name="ln-103"></a><span class="c">!!     ! unnamed strings</span>
<a name="ln-104"></a><span class="c">!!     !</span>
<a name="ln-105"></a><span class="c">!!     if(size(filenames).gt.0)then</span>
<a name="ln-106"></a><span class="c">!!        write(*,&#39;(i6.6,3a)&#39;)(i,&#39;[&#39;,filenames(i),&#39;]&#39;,i=1,size(filenames))</span>
<a name="ln-107"></a><span class="c">!!     endif</span>
<a name="ln-108"></a><span class="c">!!     !</span>
<a name="ln-109"></a><span class="c">!!     end program demo_M_CLI2</span>
<a name="ln-110"></a><span class="c">!!</span>
<a name="ln-111"></a><span class="c">!!##AUTHOR</span>
<a name="ln-112"></a><span class="c">!!     John S. Urban, 2019</span>
<a name="ln-113"></a><span class="c">!!##LICENSE</span>
<a name="ln-114"></a><span class="c">!!     Public Domain</span>
<a name="ln-115"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-116"></a><span class="k">module </span><span class="n">M_CLI2</span>
<a name="ln-117"></a><span class="k">use</span><span class="p">,</span> <span class="k">intrinsic</span> <span class="kd">::</span> <span class="n">iso_fortran_env</span><span class="p">,</span> <span class="k">only</span> <span class="p">:</span> <span class="n">stderr</span><span class="o">=&gt;</span><span class="n">ERROR_UNIT</span><span class="p">,</span> <span class="n">stdin</span><span class="o">=&gt;</span><span class="n">INPUT_UNIT</span><span class="p">,</span> <span class="n">stdout</span><span class="o">=&gt;</span><span class="n">OUTPUT_UNIT</span><span class="p">,</span> <span class="n">warn</span><span class="o">=&gt;</span><span class="n">OUTPUT_UNIT</span>
<a name="ln-118"></a>
<a name="ln-119"></a><span class="c">! copied to M_CLI2 for a stand-alone version</span>
<a name="ln-120"></a><span class="c">!use M_strings,                     only : upper, lower, quote, replace_str=&gt;replace, unquote, split, string_to_value, atleast</span>
<a name="ln-121"></a><span class="c">!use M_list,                        only : insert, locate, remove, replace</span>
<a name="ln-122"></a><span class="c">!use M_args,                        only : longest_command_argument</span>
<a name="ln-123"></a><span class="c">!use M_journal,                     only : journal</span>
<a name="ln-124"></a>
<a name="ln-125"></a><span class="k">implicit none</span>
<a name="ln-126"></a><span class="kt">integer</span><span class="p">,</span><span class="k">parameter</span><span class="p">,</span><span class="k">private</span> <span class="kd">::</span> <span class="n">dp</span><span class="o">=</span><span class="nb">kind</span><span class="p">(</span><span class="mf">0.0d0</span><span class="p">)</span>
<a name="ln-127"></a><span class="kt">integer</span><span class="p">,</span><span class="k">parameter</span><span class="p">,</span><span class="k">private</span> <span class="kd">::</span> <span class="n">sp</span><span class="o">=</span><span class="nb">kind</span><span class="p">(</span><span class="mf">0.0</span><span class="p">)</span>
<a name="ln-128"></a><span class="k">private</span>
<a name="ln-129"></a><span class="c">!logical,save :: debug_m_cli2=.true.</span>
<a name="ln-130"></a><span class="kt">logical</span><span class="p">,</span><span class="k">public</span><span class="p">,</span><span class="k">save</span> <span class="kd">::</span> <span class="n">debug_m_cli2</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>
<a name="ln-131"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-132"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">parameter</span>          <span class="kd">::</span> <span class="n">gen</span><span class="o">=</span><span class="s1">&#39;(*(g0))&#39;</span>
<a name="ln-133"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span><span class="p">,</span><span class="k">public</span> <span class="kd">::</span> <span class="n">unnamed</span><span class="p">(:)</span>
<a name="ln-134"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span><span class="p">,</span><span class="k">public</span> <span class="kd">::</span> <span class="n">args</span><span class="p">(:)</span>
<a name="ln-135"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span><span class="p">,</span><span class="k">public</span> <span class="kd">::</span> <span class="n">remaining</span>
<a name="ln-136"></a><span class="k">public</span>                              <span class="kd">::</span> <span class="n">set_args</span>
<a name="ln-137"></a><span class="k">public</span>                              <span class="kd">::</span> <span class="n">get_subcommand</span>
<a name="ln-138"></a><span class="k">public</span>                              <span class="kd">::</span> <span class="n">get_args</span>
<a name="ln-139"></a><span class="k">public</span>                              <span class="kd">::</span> <span class="n">get_args_fixed_size</span>
<a name="ln-140"></a><span class="k">public</span>                              <span class="kd">::</span> <span class="n">get_args_fixed_length</span>
<a name="ln-141"></a><span class="k">public</span>                              <span class="kd">::</span> <span class="n">specified</span>
<a name="ln-142"></a><span class="k">public</span>                              <span class="kd">::</span> <span class="n">print_dictionary</span>
<a name="ln-143"></a>
<a name="ln-144"></a><span class="k">public</span>                              <span class="kd">::</span> <span class="n">dget</span><span class="p">,</span> <span class="n">iget</span><span class="p">,</span> <span class="n">lget</span><span class="p">,</span> <span class="n">rget</span><span class="p">,</span> <span class="n">sget</span><span class="p">,</span> <span class="n">cget</span>
<a name="ln-145"></a><span class="k">public</span>                              <span class="kd">::</span> <span class="n">dgets</span><span class="p">,</span> <span class="n">igets</span><span class="p">,</span> <span class="n">lgets</span><span class="p">,</span> <span class="n">rgets</span><span class="p">,</span> <span class="n">sgets</span><span class="p">,</span> <span class="n">cgets</span>
<a name="ln-146"></a><span class="k">public</span>                              <span class="kd">::</span> <span class="n">CLI_RESPONSE_FILE</span>
<a name="ln-147"></a>
<a name="ln-148"></a><span class="k">private</span> <span class="kd">::</span> <span class="n">check_commandline</span>
<a name="ln-149"></a><span class="k">private</span> <span class="kd">::</span> <span class="n">wipe_dictionary</span>
<a name="ln-150"></a><span class="k">private</span> <span class="kd">::</span> <span class="n">prototype_to_dictionary</span>
<a name="ln-151"></a><span class="k">private</span> <span class="kd">::</span> <span class="n">update</span>
<a name="ln-152"></a><span class="k">private</span> <span class="kd">::</span> <span class="n">prototype_and_cmd_args_to_nlist</span>
<a name="ln-153"></a><span class="k">private</span> <span class="kd">::</span> <span class="n">get</span>
<a name="ln-154"></a>
<a name="ln-155"></a><span class="k">type </span><span class="n">option</span>
<a name="ln-156"></a>   <span class="kt">character</span><span class="p">(:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">shortname</span>
<a name="ln-157"></a>   <span class="kt">character</span><span class="p">(:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">longname</span>
<a name="ln-158"></a>   <span class="kt">character</span><span class="p">(:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="k">value</span>
<a name="ln-159"></a><span class="k">   </span><span class="kt">integer</span>                  <span class="kd">::</span> <span class="n">length</span>
<a name="ln-160"></a>   <span class="kt">logical</span>                  <span class="kd">::</span> <span class="n">present_in</span>
<a name="ln-161"></a>   <span class="kt">logical</span>                  <span class="kd">::</span> <span class="n">mandatory</span>
<a name="ln-162"></a><span class="k">end type </span><span class="n">option</span>
<a name="ln-163"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-164"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span><span class="p">,</span><span class="k">save</span> <span class="kd">::</span> <span class="n">keywords</span><span class="p">(:)</span>
<a name="ln-165"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span><span class="p">,</span><span class="k">save</span> <span class="kd">::</span> <span class="n">shorts</span><span class="p">(:)</span>
<a name="ln-166"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span><span class="p">,</span><span class="k">save</span> <span class="kd">::</span> <span class="n">values</span><span class="p">(:)</span>
<a name="ln-167"></a><span class="kt">integer</span><span class="p">,</span><span class="k">allocatable</span><span class="p">,</span><span class="k">save</span>          <span class="kd">::</span> <span class="n">counts</span><span class="p">(:)</span>
<a name="ln-168"></a><span class="kt">logical</span><span class="p">,</span><span class="k">allocatable</span><span class="p">,</span><span class="k">save</span>          <span class="kd">::</span> <span class="n">present_in</span><span class="p">(:)</span>
<a name="ln-169"></a><span class="kt">logical</span><span class="p">,</span><span class="k">allocatable</span><span class="p">,</span><span class="k">save</span>          <span class="kd">::</span> <span class="n">mandatory</span><span class="p">(:)</span>
<a name="ln-170"></a>
<a name="ln-171"></a><span class="kt">logical</span><span class="p">,</span><span class="k">save</span>                      <span class="kd">::</span> <span class="n">G_keyword_single_letter</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.</span>
<a name="ln-172"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span><span class="p">,</span><span class="k">save</span> <span class="kd">::</span> <span class="n">G_passed_in</span>
<a name="ln-173"></a><span class="kt">logical</span><span class="p">,</span><span class="k">save</span>                      <span class="kd">::</span> <span class="n">G_remaining_on</span><span class="p">,</span> <span class="n">G_remaining_option_allowed</span>
<a name="ln-174"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span><span class="p">,</span><span class="k">save</span> <span class="kd">::</span> <span class="n">G_remaining</span>
<a name="ln-175"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span><span class="p">,</span><span class="k">save</span> <span class="kd">::</span> <span class="n">G_subcommand</span>              <span class="c">! possible candidate for a subcommand</span>
<a name="ln-176"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span><span class="p">,</span><span class="k">save</span> <span class="kd">::</span> <span class="n">G_STOP_MESSAGE</span>
<a name="ln-177"></a><span class="kt">integer</span><span class="p">,</span><span class="k">save</span>                      <span class="kd">::</span> <span class="n">G_STOP</span>
<a name="ln-178"></a><span class="kt">logical</span><span class="p">,</span><span class="k">save</span>                      <span class="kd">::</span> <span class="n">G_QUIET</span>
<a name="ln-179"></a><span class="kt">logical</span><span class="p">,</span><span class="k">save</span>                      <span class="kd">::</span> <span class="n">G_STRICT</span>                  <span class="c">! strict short and long rules or allow -longname and --shortname</span>
<a name="ln-180"></a><span class="c">!----------------------------------------------</span>
<a name="ln-181"></a><span class="c">! try out response files</span>
<a name="ln-182"></a><span class="kt">logical</span><span class="p">,</span><span class="k">save</span>                      <span class="kd">::</span> <span class="n">CLI_RESPONSE_FILE</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span> <span class="c">! allow @name abbreviations</span>
<a name="ln-183"></a><span class="kt">logical</span><span class="p">,</span><span class="k">save</span>                      <span class="kd">::</span> <span class="n">G_APPEND</span>                  <span class="c">! whether to append or replace when duplicate keywords found</span>
<a name="ln-184"></a><span class="kt">logical</span><span class="p">,</span><span class="k">save</span>                      <span class="kd">::</span> <span class="n">G_OPTIONS_ONLY</span>            <span class="c">! process response file only looking for options for get_subcommand()</span>
<a name="ln-185"></a><span class="kt">logical</span><span class="p">,</span><span class="k">save</span>                      <span class="kd">::</span> <span class="n">G_RESPONSE</span>                <span class="c">! allow @name abbreviations</span>
<a name="ln-186"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span><span class="p">,</span><span class="k">save</span> <span class="kd">::</span> <span class="n">G_RESPONSE_IGNORED</span>
<a name="ln-187"></a><span class="c">!----------------------------------------------</span>
<a name="ln-188"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-189"></a><span class="c">! return allocatable arrays</span>
<a name="ln-190"></a><span class="k">interface  </span><span class="n">get_args</span><span class="p">;</span>  <span class="k">module  procedure  </span><span class="n">get_anyarray_d</span><span class="p">;</span>  <span class="k">end interface</span>  <span class="c">! any size array</span>
<a name="ln-191"></a><span class="k">interface  </span><span class="n">get_args</span><span class="p">;</span>  <span class="k">module  procedure  </span><span class="n">get_anyarray_i</span><span class="p">;</span>  <span class="k">end interface</span>  <span class="c">! any size array</span>
<a name="ln-192"></a><span class="k">interface  </span><span class="n">get_args</span><span class="p">;</span>  <span class="k">module  procedure  </span><span class="n">get_anyarray_r</span><span class="p">;</span>  <span class="k">end interface</span>  <span class="c">! any size array</span>
<a name="ln-193"></a><span class="k">interface  </span><span class="n">get_args</span><span class="p">;</span>  <span class="k">module  procedure  </span><span class="n">get_anyarray_x</span><span class="p">;</span>  <span class="k">end interface</span>  <span class="c">! any size array</span>
<a name="ln-194"></a><span class="k">interface  </span><span class="n">get_args</span><span class="p">;</span>  <span class="k">module  procedure  </span><span class="n">get_anyarray_c</span><span class="p">;</span>  <span class="k">end interface</span>  <span class="c">! any size array and any length</span>
<a name="ln-195"></a><span class="k">interface  </span><span class="n">get_args</span><span class="p">;</span>  <span class="k">module  procedure  </span><span class="n">get_anyarray_l</span><span class="p">;</span>  <span class="k">end interface</span>  <span class="c">! any size array</span>
<a name="ln-196"></a>
<a name="ln-197"></a><span class="c">! return scalars</span>
<a name="ln-198"></a><span class="k">interface  </span><span class="n">get_args</span><span class="p">;</span>  <span class="k">module  procedure  </span><span class="n">get_scalar_d</span><span class="p">;</span>               <span class="k">end interface</span>
<a name="ln-199"></a><span class="k">interface  </span><span class="n">get_args</span><span class="p">;</span>  <span class="k">module  procedure  </span><span class="n">get_scalar_i</span><span class="p">;</span>               <span class="k">end interface</span>
<a name="ln-200"></a><span class="k">interface  </span><span class="n">get_args</span><span class="p">;</span>  <span class="k">module  procedure  </span><span class="n">get_scalar_real</span><span class="p">;</span>            <span class="k">end interface</span>
<a name="ln-201"></a><span class="k">interface  </span><span class="n">get_args</span><span class="p">;</span>  <span class="k">module  procedure  </span><span class="n">get_scalar_complex</span><span class="p">;</span>         <span class="k">end interface</span>
<a name="ln-202"></a><span class="k">interface  </span><span class="n">get_args</span><span class="p">;</span>  <span class="k">module  procedure  </span><span class="n">get_scalar_logical</span><span class="p">;</span>         <span class="k">end interface</span>
<a name="ln-203"></a><span class="k">interface  </span><span class="n">get_args</span><span class="p">;</span>  <span class="k">module  procedure  </span><span class="n">get_scalar_anylength_c</span><span class="p">;</span>     <span class="k">end interface</span>  <span class="c">! any length</span>
<a name="ln-204"></a><span class="c">! multiple scalars</span>
<a name="ln-205"></a><span class="k">interface  </span><span class="n">get_args</span><span class="p">;</span>  <span class="k">module  procedure  </span><span class="n">many_args</span><span class="p">;</span>               <span class="k">end  interface</span>
<a name="ln-206"></a><span class="c">!==================================================================================================================================</span>
<a name="ln-207"></a><span class="c">! return non-allocatable arrays</span>
<a name="ln-208"></a><span class="c">! said in conflict with get_args_*. Using class to get around that.</span>
<a name="ln-209"></a><span class="c">! that did not work either. Adding size parameter as optional parameter works; but using a different name</span>
<a name="ln-210"></a><span class="k">interface  </span><span class="n">get_args_fixed_size</span><span class="p">;</span>  <span class="k">module procedure </span><span class="n">get_fixedarray_class</span><span class="p">;</span>            <span class="k">end interface</span> <span class="c">! any length, fixed size array</span>
<a name="ln-211"></a><span class="c">!interface   get_args;           module procedure get_fixedarray_d;                end interface</span>
<a name="ln-212"></a><span class="c">!interface   get_args;           module procedure get_fixedarray_i;                end interface</span>
<a name="ln-213"></a><span class="c">!interface   get_args;           module procedure get_fixedarray_r;                end interface</span>
<a name="ln-214"></a><span class="c">!interface   get_args;           module procedure get_fixedarray_l;                end interface</span>
<a name="ln-215"></a><span class="c">!interface   get_args;           module procedure get_fixedarray_fixed_length_c;   end interface</span>
<a name="ln-216"></a>
<a name="ln-217"></a><span class="k">interface   </span><span class="n">get_args_fixed_length</span><span class="p">;</span>  <span class="k">module  procedure  </span><span class="n">get_args_fixed_length_a_array</span><span class="p">;</span> <span class="k">end interface</span>  <span class="c">! fixed length any size array</span>
<a name="ln-218"></a><span class="k">interface   </span><span class="n">get_args_fixed_length</span><span class="p">;</span>  <span class="k">module  procedure  </span><span class="n">get_args_fixed_length_scalar_c</span><span class="p">;</span>  <span class="k">end interface</span>       <span class="c">! fixed length</span>
<a name="ln-219"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-220"></a><span class="c">!intrinsic findloc</span>
<a name="ln-221"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-222"></a>
<a name="ln-223"></a><span class="c">! ident_1=&quot;@(#)M_CLI2::str(3f): {msg_scalar,msg_one}&quot;</span>
<a name="ln-224"></a>
<a name="ln-225"></a><span class="k">private </span><span class="n">str</span>
<a name="ln-226"></a><span class="k">interface </span><span class="n">str</span>
<a name="ln-227"></a>   <span class="k">module procedure </span><span class="n">msg_scalar</span><span class="p">,</span> <span class="n">msg_one</span>
<a name="ln-228"></a><span class="k">end interface </span><span class="n">str</span>
<a name="ln-229"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-230"></a>
<a name="ln-231"></a><span class="k">private </span><span class="n">locate</span>        <span class="c">! [M_CLI2] find PLACE in sorted character array where value can be found or should be placed</span>
<a name="ln-232"></a>   <span class="k">private </span><span class="n">locate_c</span>
<a name="ln-233"></a><span class="k">private </span><span class="n">insert</span>        <span class="c">! [M_CLI2] insert entry into a sorted allocatable array at specified position</span>
<a name="ln-234"></a>   <span class="k">private </span><span class="n">insert_c</span>
<a name="ln-235"></a>   <span class="k">private </span><span class="n">insert_i</span>
<a name="ln-236"></a>   <span class="k">private </span><span class="n">insert_l</span>
<a name="ln-237"></a><span class="k">private </span><span class="n">replace</span>       <span class="c">! [M_CLI2] replace entry by index from a sorted allocatable array if it is present</span>
<a name="ln-238"></a>   <span class="k">private </span><span class="n">replace_c</span>
<a name="ln-239"></a>   <span class="k">private </span><span class="n">replace_i</span>
<a name="ln-240"></a>   <span class="k">private </span><span class="n">replace_l</span>
<a name="ln-241"></a><span class="k">private </span><span class="n">remove</span>        <span class="c">! [M_CLI2] delete entry by index from a sorted allocatable array if it is present</span>
<a name="ln-242"></a>   <span class="k">private </span><span class="n">remove_c</span>
<a name="ln-243"></a>   <span class="k">private </span><span class="n">remove_i</span>
<a name="ln-244"></a>   <span class="k">private </span><span class="n">remove_l</span>
<a name="ln-245"></a>
<a name="ln-246"></a><span class="c">! Generic subroutine inserts element into allocatable array at specified position</span>
<a name="ln-247"></a><span class="k">interface  </span><span class="n">locate</span><span class="p">;</span>   <span class="k">module procedure </span><span class="n">locate_c</span>                            <span class="p">;</span> <span class="k">end interface</span>
<a name="ln-248"></a><span class="k">interface  </span><span class="n">insert</span><span class="p">;</span>   <span class="k">module procedure </span><span class="n">insert_c</span><span class="p">,</span>      <span class="n">insert_i</span><span class="p">,</span>  <span class="n">insert_l</span>  <span class="p">;</span> <span class="k">end interface</span>
<a name="ln-249"></a><span class="k">interface  </span><span class="n">replace</span><span class="p">;</span>  <span class="k">module procedure </span><span class="n">replace_c</span><span class="p">,</span>     <span class="n">replace_i</span><span class="p">,</span> <span class="n">replace_l</span> <span class="p">;</span> <span class="k">end interface</span>
<a name="ln-250"></a><span class="k">interface  </span><span class="n">remove</span><span class="p">;</span>   <span class="k">module procedure </span><span class="n">remove_c</span><span class="p">,</span>      <span class="n">remove_i</span><span class="p">,</span>  <span class="n">remove_l</span>  <span class="p">;</span> <span class="k">end interface</span>
<a name="ln-251"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-252"></a><span class="c">! convenience functions</span>
<a name="ln-253"></a><span class="k">interface </span><span class="n">cgets</span><span class="p">;</span><span class="k">module procedure </span><span class="n">cgs</span><span class="p">,</span> <span class="n">cg</span><span class="p">;</span><span class="k">end interface</span>
<a name="ln-254"></a><span class="k">interface </span><span class="n">dgets</span><span class="p">;</span><span class="k">module procedure </span><span class="n">dgs</span><span class="p">,</span> <span class="n">dg</span><span class="p">;</span><span class="k">end interface</span>
<a name="ln-255"></a><span class="k">interface </span><span class="n">igets</span><span class="p">;</span><span class="k">module procedure </span><span class="n">igs</span><span class="p">,</span> <span class="n">ig</span><span class="p">;</span><span class="k">end interface</span>
<a name="ln-256"></a><span class="k">interface </span><span class="n">lgets</span><span class="p">;</span><span class="k">module procedure </span><span class="n">lgs</span><span class="p">,</span> <span class="n">lg</span><span class="p">;</span><span class="k">end interface</span>
<a name="ln-257"></a><span class="k">interface </span><span class="n">rgets</span><span class="p">;</span><span class="k">module procedure </span><span class="n">rgs</span><span class="p">,</span> <span class="n">rg</span><span class="p">;</span><span class="k">end interface</span>
<a name="ln-258"></a><span class="k">interface </span><span class="n">sgets</span><span class="p">;</span><span class="k">module procedure </span><span class="n">sgs</span><span class="p">,</span> <span class="n">sg</span><span class="p">;</span><span class="k">end interface</span>
<a name="ln-259"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-260"></a><span class="k">contains</span>
<a name="ln-261"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-262"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-263"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-264"></a><span class="c">!&gt;</span>
<a name="ln-265"></a><span class="c">!!##NAME</span>
<a name="ln-266"></a><span class="c">!!     check_commandline(3f) - [ARGUMENTS:M_CLI2]check command and process</span>
<a name="ln-267"></a><span class="c">!!     pre-defined options</span>
<a name="ln-268"></a><span class="c">!!</span>
<a name="ln-269"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-270"></a><span class="c">!!</span>
<a name="ln-271"></a><span class="c">!!      subroutine check_commandline(help_text,version_text,ierr,errmsg)</span>
<a name="ln-272"></a><span class="c">!!</span>
<a name="ln-273"></a><span class="c">!!       character(len=*),intent(in),optional :: help_text(:)</span>
<a name="ln-274"></a><span class="c">!!       character(len=*),intent(in),optional :: version_text(:)</span>
<a name="ln-275"></a><span class="c">!!</span>
<a name="ln-276"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-277"></a><span class="c">!!     Checks the commandline  and processes the implicit --help, --version,</span>
<a name="ln-278"></a><span class="c">!!     --verbose, and --usage parameters.</span>
<a name="ln-279"></a><span class="c">!!</span>
<a name="ln-280"></a><span class="c">!!     If the optional text values are supplied they will be displayed by</span>
<a name="ln-281"></a><span class="c">!!     --help and --version command-line options, respectively.</span>
<a name="ln-282"></a><span class="c">!!</span>
<a name="ln-283"></a><span class="c">!!##OPTIONS</span>
<a name="ln-284"></a><span class="c">!!</span>
<a name="ln-285"></a><span class="c">!!     HELP_TEXT     if present, will be displayed if program is called with</span>
<a name="ln-286"></a><span class="c">!!                   --help switch, and then the program will terminate. If</span>
<a name="ln-287"></a><span class="c">!!                   not supplied, the command line initialized string will be</span>
<a name="ln-288"></a><span class="c">!!                   shown when --help is used on the commandline.</span>
<a name="ln-289"></a><span class="c">!!</span>
<a name="ln-290"></a><span class="c">!!     VERSION_TEXT  if present, will be displayed if program is called with</span>
<a name="ln-291"></a><span class="c">!!                   --version switch, and then the program will terminate.</span>
<a name="ln-292"></a><span class="c">!!</span>
<a name="ln-293"></a><span class="c">!!        If the first four characters of each line are &quot;@(#)&quot; this prefix</span>
<a name="ln-294"></a><span class="c">!!        will not be displayed and the last non-blank letter will be</span>
<a name="ln-295"></a><span class="c">!!        removed from each line. This if for support of the SCCS what(1)</span>
<a name="ln-296"></a><span class="c">!!        command. If you do not have the what(1) command on GNU/Linux and</span>
<a name="ln-297"></a><span class="c">!!        Unix platforms you can probably see how it can be used to place</span>
<a name="ln-298"></a><span class="c">!!        metadata in a binary by entering:</span>
<a name="ln-299"></a><span class="c">!!</span>
<a name="ln-300"></a><span class="c">!!         strings demo_commandline|grep &#39;@(#)&#39;|tr &#39;&gt;&#39; &#39;\n&#39;|sed -e &#39;s/  */ /g&#39;</span>
<a name="ln-301"></a><span class="c">!!</span>
<a name="ln-302"></a><span class="c">!!##EXAMPLE</span>
<a name="ln-303"></a><span class="c">!!</span>
<a name="ln-304"></a><span class="c">!!</span>
<a name="ln-305"></a><span class="c">!! Typical usage:</span>
<a name="ln-306"></a><span class="c">!!</span>
<a name="ln-307"></a><span class="c">!!      program check_commandline</span>
<a name="ln-308"></a><span class="c">!!      use M_CLI2,  only : unnamed, set_args, get_args</span>
<a name="ln-309"></a><span class="c">!!      implicit none</span>
<a name="ln-310"></a><span class="c">!!      integer                      :: i</span>
<a name="ln-311"></a><span class="c">!!      character(len=:),allocatable :: version_text(:), help_text(:)</span>
<a name="ln-312"></a><span class="c">!!      real               :: x, y, z</span>
<a name="ln-313"></a><span class="c">!!      character(len=*),parameter :: cmd=&#39;-x 1 -y 2 -z 3&#39;</span>
<a name="ln-314"></a><span class="c">!!         version_text=[character(len=80) :: &quot;version 1.0&quot;,&quot;author: me&quot;]</span>
<a name="ln-315"></a><span class="c">!!         help_text=[character(len=80) :: &amp;</span>
<a name="ln-316"></a><span class="c">!!                 &amp; &quot;wish I put instructions&quot;,&quot;here&quot;,&quot;I suppose?&quot;]</span>
<a name="ln-317"></a><span class="c">!!         call set_args(cmd,help_text,version_text)</span>
<a name="ln-318"></a><span class="c">!!         call get_args(&#39;x&#39;,x,&#39;y&#39;,y,&#39;z&#39;,z)</span>
<a name="ln-319"></a><span class="c">!!         ! All done cracking the command line. Use the values in your program.</span>
<a name="ln-320"></a><span class="c">!!         write (*,*)x,y,z</span>
<a name="ln-321"></a><span class="c">!!         ! the optional unnamed values on the command line are</span>
<a name="ln-322"></a><span class="c">!!         ! accumulated in the character array &quot;UNNAMED&quot;</span>
<a name="ln-323"></a><span class="c">!!         if(size(unnamed).gt.0)then</span>
<a name="ln-324"></a><span class="c">!!            write (*,&#39;(a)&#39;)&#39;files:&#39;</span>
<a name="ln-325"></a><span class="c">!!            write (*,&#39;(i6.6,3a)&#39;) (i,&#39;[&#39;,unnamed(i),&#39;]&#39;,i=1,size(unnamed))</span>
<a name="ln-326"></a><span class="c">!!         endif</span>
<a name="ln-327"></a><span class="c">!!      end program check_commandline</span>
<a name="ln-328"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-329"></a><span class="k">subroutine </span><span class="n">check_commandline</span><span class="p">(</span><span class="n">help_text</span><span class="p">,</span><span class="n">version_text</span><span class="p">)</span>
<a name="ln-330"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">help_text</span><span class="p">(:)</span>
<a name="ln-331"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">version_text</span><span class="p">(:)</span>
<a name="ln-332"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>         <span class="kd">::</span> <span class="n">line</span>
<a name="ln-333"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">i</span>
<a name="ln-334"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">istart</span>
<a name="ln-335"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">iback</span>
<a name="ln-336"></a>   <span class="k">if</span><span class="p">(</span><span class="n">get</span><span class="p">(</span><span class="s1">&#39;usage&#39;</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="s1">&#39;T&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-337"></a><span class="k">      call </span><span class="n">print_dictionary</span><span class="p">(</span><span class="s1">&#39;USAGE:&#39;</span><span class="p">)</span>
<a name="ln-338"></a>      <span class="c">!x!call default_help()</span>
<a name="ln-339"></a>      <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">32</span><span class="p">)</span>
<a name="ln-340"></a>      <span class="k">return</span>
<a name="ln-341"></a><span class="k">   endif</span>
<a name="ln-342"></a><span class="k">   if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">help_text</span><span class="p">))</span><span class="k">then</span>
<a name="ln-343"></a><span class="k">      if</span><span class="p">(</span><span class="n">get</span><span class="p">(</span><span class="s1">&#39;help&#39;</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="s1">&#39;T&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-344"></a><span class="k">         do </span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">help_text</span><span class="p">)</span>
<a name="ln-345"></a>            <span class="k">call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="n">help_text</span><span class="p">(</span><span class="n">i</span><span class="p">))</span>
<a name="ln-346"></a>         <span class="k">enddo</span>
<a name="ln-347"></a><span class="k">         call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">1</span><span class="p">,</span><span class="s1">&#39;displayed help text&#39;</span><span class="p">)</span>
<a name="ln-348"></a>         <span class="k">return</span>
<a name="ln-349"></a><span class="k">      endif</span>
<a name="ln-350"></a><span class="k">   </span><span class="n">elseif</span><span class="p">(</span><span class="n">get</span><span class="p">(</span><span class="s1">&#39;help&#39;</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="s1">&#39;T&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-351"></a><span class="k">      call </span><span class="n">default_help</span><span class="p">()</span>
<a name="ln-352"></a>      <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">2</span><span class="p">,</span><span class="s1">&#39;displayed default help text&#39;</span><span class="p">)</span>
<a name="ln-353"></a>      <span class="k">return</span>
<a name="ln-354"></a><span class="k">   endif</span>
<a name="ln-355"></a><span class="k">   if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">version_text</span><span class="p">))</span><span class="k">then</span>
<a name="ln-356"></a><span class="k">      if</span><span class="p">(</span><span class="n">get</span><span class="p">(</span><span class="s1">&#39;version&#39;</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="s1">&#39;T&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-357"></a><span class="k">         </span><span class="n">istart</span><span class="o">=</span><span class="mi">1</span>
<a name="ln-358"></a>         <span class="n">iback</span><span class="o">=</span><span class="mi">0</span>
<a name="ln-359"></a>         <span class="k">if</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">version_text</span><span class="p">).</span><span class="n">gt</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-360"></a><span class="k">            if</span><span class="p">(</span><span class="nb">index</span><span class="p">(</span><span class="n">version_text</span><span class="p">(</span><span class="mi">1</span><span class="p">),</span><span class="s1">&#39;@&#39;</span><span class="o">//</span><span class="s1">&#39;(#)&#39;</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="mi">1</span><span class="p">)</span><span class="k">then</span> <span class="c">! allow for what(1) syntax</span>
<a name="ln-361"></a>               <span class="n">istart</span><span class="o">=</span><span class="mi">5</span>
<a name="ln-362"></a>               <span class="n">iback</span><span class="o">=</span><span class="mi">1</span>
<a name="ln-363"></a>            <span class="k">endif</span>
<a name="ln-364"></a><span class="k">         endif</span>
<a name="ln-365"></a><span class="k">         do </span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">version_text</span><span class="p">)</span>
<a name="ln-366"></a>            <span class="c">!xINTEL BUG*!call journal(&#39;sc&#39;,version_text(i)(istart:len_trim(version_text(i))-iback))</span>
<a name="ln-367"></a>            <span class="n">line</span><span class="o">=</span><span class="n">version_text</span><span class="p">(</span><span class="n">i</span><span class="p">)(</span><span class="n">istart</span><span class="p">:</span><span class="nb">len_trim</span><span class="p">(</span><span class="n">version_text</span><span class="p">(</span><span class="n">i</span><span class="p">))</span><span class="o">-</span><span class="n">iback</span><span class="p">)</span>
<a name="ln-368"></a>            <span class="k">call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="n">line</span><span class="p">)</span>
<a name="ln-369"></a>         <span class="k">enddo</span>
<a name="ln-370"></a><span class="k">         call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">3</span><span class="p">,</span><span class="s1">&#39;displayed version text&#39;</span><span class="p">)</span>
<a name="ln-371"></a>         <span class="k">return</span>
<a name="ln-372"></a><span class="k">      endif</span>
<a name="ln-373"></a><span class="k">   </span><span class="n">elseif</span><span class="p">(</span><span class="n">get</span><span class="p">(</span><span class="s1">&#39;version&#39;</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="s1">&#39;T&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-374"></a>
<a name="ln-375"></a><span class="k">      if</span><span class="p">(</span><span class="n">G_QUIET</span><span class="p">)</span><span class="k">then</span>
<a name="ln-376"></a><span class="k">         </span><span class="n">G_STOP_MESSAGE</span> <span class="o">=</span> <span class="s1">&#39;no version text&#39;</span>
<a name="ln-377"></a>      <span class="k">else</span>
<a name="ln-378"></a><span class="k">         call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*check_commandline* no version text&#39;</span><span class="p">)</span>
<a name="ln-379"></a>      <span class="k">endif</span>
<a name="ln-380"></a><span class="k">      call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">4</span><span class="p">,</span><span class="s1">&#39;displayed default version text&#39;</span><span class="p">)</span>
<a name="ln-381"></a>      <span class="k">return</span>
<a name="ln-382"></a><span class="k">   endif</span>
<a name="ln-383"></a><span class="k">contains</span>
<a name="ln-384"></a><span class="k">subroutine </span><span class="n">default_help</span><span class="p">()</span>
<a name="ln-385"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">cmd_name</span>
<a name="ln-386"></a><span class="kt">integer</span> <span class="kd">::</span> <span class="n">ilength</span>
<a name="ln-387"></a>   <span class="k">call </span><span class="nb">get_command_argument</span><span class="p">(</span><span class="n">number</span><span class="o">=</span><span class="mi">0</span><span class="p">,</span><span class="n">length</span><span class="o">=</span><span class="n">ilength</span><span class="p">)</span>
<a name="ln-388"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">cmd_name</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">cmd_name</span><span class="p">)</span>
<a name="ln-389"></a>   <span class="k">allocate</span><span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="n">ilength</span><span class="p">)</span> <span class="kd">::</span> <span class="n">cmd_name</span><span class="p">)</span>
<a name="ln-390"></a>   <span class="k">call </span><span class="nb">get_command_argument</span><span class="p">(</span><span class="n">number</span><span class="o">=</span><span class="mi">0</span><span class="p">,</span><span class="k">value</span><span class="o">=</span><span class="n">cmd_name</span><span class="p">)</span>
<a name="ln-391"></a>   <span class="n">G_passed_in</span><span class="o">=</span><span class="n">G_passed_in</span><span class="o">//</span><span class="nb">repeat</span><span class="p">(</span><span class="s1">&#39; &#39;</span><span class="p">,</span><span class="nb">len</span><span class="p">(</span><span class="n">G_passed_in</span><span class="p">))</span>
<a name="ln-392"></a>   <span class="k">call </span><span class="n">substitute</span><span class="p">(</span><span class="n">G_passed_in</span><span class="p">,</span><span class="s1">&#39; --&#39;</span><span class="p">,</span><span class="nb">NEW_LINE</span><span class="p">(</span><span class="s1">&#39;A&#39;</span><span class="p">)</span><span class="o">//</span><span class="s1">&#39; --&#39;</span><span class="p">)</span>
<a name="ln-393"></a>   <span class="k">if</span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="n">G_QUIET</span><span class="p">)</span><span class="k">then</span>
<a name="ln-394"></a><span class="k">      call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="n">cmd_name</span><span class="p">,</span><span class="n">G_passed_in</span><span class="p">)</span> <span class="c">! no help text, echo command and default options</span>
<a name="ln-395"></a>   <span class="k">endif</span>
<a name="ln-396"></a><span class="k">   deallocate</span><span class="p">(</span><span class="n">cmd_name</span><span class="p">)</span>
<a name="ln-397"></a><span class="k">end subroutine </span><span class="n">default_help</span>
<a name="ln-398"></a><span class="k">end subroutine </span><span class="n">check_commandline</span>
<a name="ln-399"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-400"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-401"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-402"></a><span class="c">!&gt;</span>
<a name="ln-403"></a><span class="c">!!##NAME</span>
<a name="ln-404"></a><span class="c">!!     set_args(3f) - [ARGUMENTS:M_CLI2] command line argument parsing</span>
<a name="ln-405"></a><span class="c">!!     (LICENSE:PD)</span>
<a name="ln-406"></a><span class="c">!!</span>
<a name="ln-407"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-408"></a><span class="c">!!</span>
<a name="ln-409"></a><span class="c">!!     subroutine set_args(definition,help_text,version_text,ierr,errmsg)</span>
<a name="ln-410"></a><span class="c">!!</span>
<a name="ln-411"></a><span class="c">!!      character(len=*),intent(in),optional              :: definition</span>
<a name="ln-412"></a><span class="c">!!      character(len=*),intent(in),optional              :: help_text(:)</span>
<a name="ln-413"></a><span class="c">!!      character(len=*),intent(in),optional              :: version_text(:)</span>
<a name="ln-414"></a><span class="c">!!      integer,intent(out),optional                      :: ierr</span>
<a name="ln-415"></a><span class="c">!!      character(len=:),intent(out),allocatable,optional :: errmsg</span>
<a name="ln-416"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-417"></a><span class="c">!!</span>
<a name="ln-418"></a><span class="c">!!     SET_ARGS(3f) requires a unix-like command prototype for defining</span>
<a name="ln-419"></a><span class="c">!!     arguments and default command-line options. Argument values are then</span>
<a name="ln-420"></a><span class="c">!!     read using GET_ARGS(3f).</span>
<a name="ln-421"></a><span class="c">!!</span>
<a name="ln-422"></a><span class="c">!!     The --help and --version options require the optional</span>
<a name="ln-423"></a><span class="c">!!     help_text and version_text values to be provided.</span>
<a name="ln-424"></a><span class="c">!!</span>
<a name="ln-425"></a><span class="c">!!##OPTIONS</span>
<a name="ln-426"></a><span class="c">!!</span>
<a name="ln-427"></a><span class="c">!!    DEFINITION  composed of all command arguments concatenated</span>
<a name="ln-428"></a><span class="c">!!                into a Unix-like command prototype string. For</span>
<a name="ln-429"></a><span class="c">!!                example:</span>
<a name="ln-430"></a><span class="c">!!</span>
<a name="ln-431"></a><span class="c">!!                 call set_args(&#39;-L F -ints 10,20,30 -title &quot;my title&quot; -R 10.3&#39;)</span>
<a name="ln-432"></a><span class="c">!!</span>
<a name="ln-433"></a><span class="c">!!                DEFINITION is pre-defined to act as if started with</span>
<a name="ln-434"></a><span class="c">!!                the reserved options &#39;--verbose F --usage F --help</span>
<a name="ln-435"></a><span class="c">!!                F --version F&#39;. The --usage option is processed when</span>
<a name="ln-436"></a><span class="c">!!                the set_args(3f) routine is called. The same is true</span>
<a name="ln-437"></a><span class="c">!!                for --help and --version if the optional help_text</span>
<a name="ln-438"></a><span class="c">!!                and version_text options are provided.</span>
<a name="ln-439"></a><span class="c">!!</span>
<a name="ln-440"></a><span class="c">!!                see &quot;DEFINING THE PROTOTYPE&quot; in the next section for</span>
<a name="ln-441"></a><span class="c">!!                further details.</span>
<a name="ln-442"></a><span class="c">!!</span>
<a name="ln-443"></a><span class="c">!!    HELP_TEXT   if present, will be displayed if program is called with</span>
<a name="ln-444"></a><span class="c">!!                --help switch, and then the program will terminate. If</span>
<a name="ln-445"></a><span class="c">!!                not supplied, the command line initialization string</span>
<a name="ln-446"></a><span class="c">!!                will be shown when --help is used on the commandline.</span>
<a name="ln-447"></a><span class="c">!!</span>
<a name="ln-448"></a><span class="c">!!      VERSION_TEXT  if present, will be displayed if program is called with</span>
<a name="ln-449"></a><span class="c">!!                    --version switch, and then the program will terminate.</span>
<a name="ln-450"></a><span class="c">!!      IERR          if present a non-zero option is returned when an</span>
<a name="ln-451"></a><span class="c">!!                    error occurs instead of program execution being</span>
<a name="ln-452"></a><span class="c">!!                    terminated</span>
<a name="ln-453"></a><span class="c">!!      ERRMSG        a description of the error if ierr is present</span>
<a name="ln-454"></a><span class="c">!!</span>
<a name="ln-455"></a><span class="c">!!##DEFINING THE PROTOTYPE</span>
<a name="ln-456"></a><span class="c">!!         o all keywords on the prototype MUST get a value.</span>
<a name="ln-457"></a><span class="c">!!</span>
<a name="ln-458"></a><span class="c">!!         o logicals MUST be set to F or T.</span>
<a name="ln-459"></a><span class="c">!!</span>
<a name="ln-460"></a><span class="c">!!         o strings MUST be delimited with double-quotes and</span>
<a name="ln-461"></a><span class="c">!!           must be at least one space. Internal double-quotes</span>
<a name="ln-462"></a><span class="c">!!           are represented with two double-quotes.</span>
<a name="ln-463"></a><span class="c">!!</span>
<a name="ln-464"></a><span class="c">!!         o numeric keywords are not allowed; but this allows</span>
<a name="ln-465"></a><span class="c">!!           negative numbers to be used as values.</span>
<a name="ln-466"></a><span class="c">!!</span>
<a name="ln-467"></a><span class="c">!!         o lists of values should be comma-delimited unless a</span>
<a name="ln-468"></a><span class="c">!!           user-specified delimiter is used. The prototype</span>
<a name="ln-469"></a><span class="c">!!           must use the same array delimiters as the call to</span>
<a name="ln-470"></a><span class="c">!!           the family of get_args*(3f) called.</span>
<a name="ln-471"></a><span class="c">!!</span>
<a name="ln-472"></a><span class="c">!!         o long names (--keyword) should be all lowercase</span>
<a name="ln-473"></a><span class="c">!!</span>
<a name="ln-474"></a><span class="c">!!         o The simplest way to have short names is to suffix the long</span>
<a name="ln-475"></a><span class="c">!!           name with :LETTER If this syntax is used then logical shorts</span>
<a name="ln-476"></a><span class="c">!!           may be combined on the command line and -- and - prefixes are</span>
<a name="ln-477"></a><span class="c">!!           strictly enforced.</span>
<a name="ln-478"></a><span class="c">!!</span>
<a name="ln-479"></a><span class="c">!!           mapping of short names to long names not using the</span>
<a name="ln-480"></a><span class="c">!!           --LONGNAME:SHORTNAME syntax is demonstrated in the manpage</span>
<a name="ln-481"></a><span class="c">!!           for SPECIFIED(3f).</span>
<a name="ln-482"></a><span class="c">!!</span>
<a name="ln-483"></a><span class="c">!!         o A very special behavior occurs if the keyword name ends in ::.</span>
<a name="ln-484"></a><span class="c">!!           The next parameter is taken as a value even if it starts with -.</span>
<a name="ln-485"></a><span class="c">!!           This is not generally recommended but is noted here for</span>
<a name="ln-486"></a><span class="c">!!           completeness.</span>
<a name="ln-487"></a><span class="c">!!</span>
<a name="ln-488"></a><span class="c">!!         o to define a zero-length allocatable array make the</span>
<a name="ln-489"></a><span class="c">!!           value a delimiter (usually a comma).</span>
<a name="ln-490"></a><span class="c">!!</span>
<a name="ln-491"></a><span class="c">!!         o all unused values go into the character array UNNAMED</span>
<a name="ln-492"></a><span class="c">!!</span>
<a name="ln-493"></a><span class="c">!!         o If the prototype ends with &quot;--&quot; a special mode is turned</span>
<a name="ln-494"></a><span class="c">!!           on where anything after &quot;--&quot; on input goes into the variable</span>
<a name="ln-495"></a><span class="c">!!           REMAINING and the array ARGS instead of becoming elements in</span>
<a name="ln-496"></a><span class="c">!!           the UNNAMED array. This is not needed for normal processing.</span>
<a name="ln-497"></a><span class="c">!!</span>
<a name="ln-498"></a><span class="c">!!##USAGE</span>
<a name="ln-499"></a><span class="c">!!      When invoking the program line note that (subject to change) the</span>
<a name="ln-500"></a><span class="c">!!      following variations from other common command-line parsers:</span>
<a name="ln-501"></a><span class="c">!!</span>
<a name="ln-502"></a><span class="c">!!         o Long names should be all lowercase and always more than one</span>
<a name="ln-503"></a><span class="c">!!           character.</span>
<a name="ln-504"></a><span class="c">!!</span>
<a name="ln-505"></a><span class="c">!!         o values for duplicate keywords are appended together with a space</span>
<a name="ln-506"></a><span class="c">!!           separator when a command line is executed.</span>
<a name="ln-507"></a><span class="c">!!</span>
<a name="ln-508"></a><span class="c">!!         o numeric keywords are not allowed; but this allows</span>
<a name="ln-509"></a><span class="c">!!           negative numbers to be used as values.</span>
<a name="ln-510"></a><span class="c">!!</span>
<a name="ln-511"></a><span class="c">!!         o Although not generally recommended you can equivalence</span>
<a name="ln-512"></a><span class="c">!!           keywords (usually for multi-lingual support). Be aware that</span>
<a name="ln-513"></a><span class="c">!!           specifying both names of an equivalenced keyword on a command</span>
<a name="ln-514"></a><span class="c">!!           line will have undefined results (currently, their ASCII</span>
<a name="ln-515"></a><span class="c">!!           alphabetical order will define what the Fortran variable</span>
<a name="ln-516"></a><span class="c">!!           values become).</span>
<a name="ln-517"></a><span class="c">!!</span>
<a name="ln-518"></a><span class="c">!!           The second of the names should only be called with a</span>
<a name="ln-519"></a><span class="c">!!           GET_ARGS*(3f) routine if the SPECIFIED(3f) function is .TRUE.</span>
<a name="ln-520"></a><span class="c">!!           for that name.</span>
<a name="ln-521"></a><span class="c">!!</span>
<a name="ln-522"></a><span class="c">!!           Note that allocatable arrays cannot be EQUIVALENCEd in Fortran.</span>
<a name="ln-523"></a><span class="c">!!</span>
<a name="ln-524"></a><span class="c">!!         o short keywords cannot be combined unless they were defined</span>
<a name="ln-525"></a><span class="c">!!           using the --LONGNAME:SHORTNAME syntax. Even then -a -b -c</span>
<a name="ln-526"></a><span class="c">!!           is required not -abc unless all the keywords are logicals</span>
<a name="ln-527"></a><span class="c">!!           (Boolean keys).</span>
<a name="ln-528"></a><span class="c">!!</span>
<a name="ln-529"></a><span class="c">!!         o shuffling is not supported. Values should follow their</span>
<a name="ln-530"></a><span class="c">!!           keywords.</span>
<a name="ln-531"></a><span class="c">!!</span>
<a name="ln-532"></a><span class="c">!!         o if a parameter value of just &quot;-&quot; is supplied it is</span>
<a name="ln-533"></a><span class="c">!!           converted to the string &quot;stdin&quot;.</span>
<a name="ln-534"></a><span class="c">!!</span>
<a name="ln-535"></a><span class="c">!!         o values not matching a keyword go into the character</span>
<a name="ln-536"></a><span class="c">!!           array &quot;UNUSED&quot;.</span>
<a name="ln-537"></a><span class="c">!!</span>
<a name="ln-538"></a><span class="c">!!         o if the keyword &quot;--&quot; is encountered the rest of the</span>
<a name="ln-539"></a><span class="c">!!           command arguments go into the character array &quot;UNUSED&quot;.</span>
<a name="ln-540"></a><span class="c">!!##EXAMPLE</span>
<a name="ln-541"></a><span class="c">!!</span>
<a name="ln-542"></a><span class="c">!! Sample program:</span>
<a name="ln-543"></a><span class="c">!!</span>
<a name="ln-544"></a><span class="c">!!     program demo_set_args</span>
<a name="ln-545"></a><span class="c">!!     use M_CLI2,  only : filenames=&gt;unnamed, set_args, get_args</span>
<a name="ln-546"></a><span class="c">!!     use M_CLI2,  only : get_args_fixed_size</span>
<a name="ln-547"></a><span class="c">!!     implicit none</span>
<a name="ln-548"></a><span class="c">!!     integer                      :: i</span>
<a name="ln-549"></a><span class="c">!!     ! DEFINE ARGS</span>
<a name="ln-550"></a><span class="c">!!     real                         :: x, y, z</span>
<a name="ln-551"></a><span class="c">!!     real                         :: p(3)</span>
<a name="ln-552"></a><span class="c">!!     character(len=:),allocatable :: title</span>
<a name="ln-553"></a><span class="c">!!     logical                      :: l, lbig</span>
<a name="ln-554"></a><span class="c">!!     integer,allocatable          :: ints(:)</span>
<a name="ln-555"></a><span class="c">!!     !</span>
<a name="ln-556"></a><span class="c">!!     !  DEFINE COMMAND (TO SET INITIAL VALUES AND ALLOWED KEYWORDS)</span>
<a name="ln-557"></a><span class="c">!!     !  AND READ COMMAND LINE</span>
<a name="ln-558"></a><span class="c">!!     call set_args(&#39; &amp;</span>
<a name="ln-559"></a><span class="c">!!        ! reals</span>
<a name="ln-560"></a><span class="c">!!        &amp; -x 1 -y 2.3 -z 3.4e2 &amp;</span>
<a name="ln-561"></a><span class="c">!!        ! integer array</span>
<a name="ln-562"></a><span class="c">!!        &amp; -p -1,-2,-3 &amp;</span>
<a name="ln-563"></a><span class="c">!!        ! always double-quote strings</span>
<a name="ln-564"></a><span class="c">!!        &amp; --title &quot;my title&quot; &amp;</span>
<a name="ln-565"></a><span class="c">!!        ! set all logical values to F or T.</span>
<a name="ln-566"></a><span class="c">!!        &amp; -l F -L F &amp;</span>
<a name="ln-567"></a><span class="c">!!        ! set allocatable size to zero if you like by using a delimiter</span>
<a name="ln-568"></a><span class="c">!!        &amp; -ints , &amp;</span>
<a name="ln-569"></a><span class="c">!!        ! string should be a single character at a minimum</span>
<a name="ln-570"></a><span class="c">!!        &amp; --label &quot; &quot; &amp;</span>
<a name="ln-571"></a><span class="c">!!        &amp; &#39;)</span>
<a name="ln-572"></a><span class="c">!!     ! ASSIGN VALUES TO ELEMENTS</span>
<a name="ln-573"></a><span class="c">!!     !     SCALARS</span>
<a name="ln-574"></a><span class="c">!!     call get_args(&#39;x&#39;,x)</span>
<a name="ln-575"></a><span class="c">!!     call get_args(&#39;y&#39;,y)</span>
<a name="ln-576"></a><span class="c">!!     call get_args(&#39;z&#39;,z)</span>
<a name="ln-577"></a><span class="c">!!     call get_args(&#39;l&#39;,l)</span>
<a name="ln-578"></a><span class="c">!!     call get_args(&#39;L&#39;,lbig)</span>
<a name="ln-579"></a><span class="c">!!     call get_args(&#39;ints&#39;,ints)      ! ALLOCATABLE ARRAY</span>
<a name="ln-580"></a><span class="c">!!     call get_args(&#39;title&#39;,title)    ! ALLOCATABLE STRING</span>
<a name="ln-581"></a><span class="c">!!     call get_args_fixed_size(&#39;p&#39;,p) ! NON-ALLOCATABLE ARRAY</span>
<a name="ln-582"></a><span class="c">!!     ! USE VALUES</span>
<a name="ln-583"></a><span class="c">!!     write(*,*)&#39;x=&#39;,x</span>
<a name="ln-584"></a><span class="c">!!     write(*,*)&#39;y=&#39;,y</span>
<a name="ln-585"></a><span class="c">!!     write(*,*)&#39;z=&#39;,z</span>
<a name="ln-586"></a><span class="c">!!     write(*,*)&#39;p=&#39;,p</span>
<a name="ln-587"></a><span class="c">!!     write(*,*)&#39;title=&#39;,title</span>
<a name="ln-588"></a><span class="c">!!     write(*,*)&#39;ints=&#39;,ints</span>
<a name="ln-589"></a><span class="c">!!     write(*,*)&#39;l=&#39;,l</span>
<a name="ln-590"></a><span class="c">!!     write(*,*)&#39;L=&#39;,lbig</span>
<a name="ln-591"></a><span class="c">!!     ! UNNAMED VALUES</span>
<a name="ln-592"></a><span class="c">!!     if(size(filenames).gt.0)then</span>
<a name="ln-593"></a><span class="c">!!        write(*,&#39;(i6.6,3a)&#39;)(i,&#39;[&#39;,filenames(i),&#39;]&#39;,i=1,size(filenames))</span>
<a name="ln-594"></a><span class="c">!!     endif</span>
<a name="ln-595"></a><span class="c">!!     end program demo_set_args</span>
<a name="ln-596"></a><span class="c">!!</span>
<a name="ln-597"></a><span class="c">!!##RESPONSE FILES</span>
<a name="ln-598"></a><span class="c">!!</span>
<a name="ln-599"></a><span class="c">!!  If you have no interest in using external files as abbreviations</span>
<a name="ln-600"></a><span class="c">!!  you can ignore this section. Otherwise, before calling set_args(3f)</span>
<a name="ln-601"></a><span class="c">!!  add:</span>
<a name="ln-602"></a><span class="c">!!</span>
<a name="ln-603"></a><span class="c">!!     use M_CLI2, only : CLI_response_file</span>
<a name="ln-604"></a><span class="c">!!     CLI_response_file=.true.</span>
<a name="ln-605"></a><span class="c">!!</span>
<a name="ln-606"></a><span class="c">!!  M_CLI2 Response files are small files containing CLI (Command Line</span>
<a name="ln-607"></a><span class="c">!!  Interface) arguments that end with &quot;.rsp&quot; that can be used when command</span>
<a name="ln-608"></a><span class="c">!!  lines are so long that they would exceed line length limits or so complex</span>
<a name="ln-609"></a><span class="c">!!  that it is useful to have a platform-independent method of creating</span>
<a name="ln-610"></a><span class="c">!!  an abbreviation.</span>
<a name="ln-611"></a><span class="c">!!</span>
<a name="ln-612"></a><span class="c">!!  Shell aliases and scripts are often used for similar purposes (and</span>
<a name="ln-613"></a><span class="c">!!  allow for much more complex conditional execution, of course), but</span>
<a name="ln-614"></a><span class="c">!!  they generally cannot be used to overcome line length limits and are</span>
<a name="ln-615"></a><span class="c">!!  typically platform-specific.</span>
<a name="ln-616"></a><span class="c">!!</span>
<a name="ln-617"></a><span class="c">!!  Examples of commands that support similar response files are the Clang</span>
<a name="ln-618"></a><span class="c">!!  and Intel compilers, although there is no standard format for the files.</span>
<a name="ln-619"></a><span class="c">!!</span>
<a name="ln-620"></a><span class="c">!!  They are read if you add options of the syntax &quot;@NAME&quot; as the FIRST</span>
<a name="ln-621"></a><span class="c">!!  parameters on your program command line calls. They are not recursive --</span>
<a name="ln-622"></a><span class="c">!!  that is, an option in a response file cannot be given the value &quot;@NAME2&quot;</span>
<a name="ln-623"></a><span class="c">!!  to call another response file.</span>
<a name="ln-624"></a><span class="c">!!</span>
<a name="ln-625"></a><span class="c">!!  Note that more than one response name may appear on a command line.</span>
<a name="ln-626"></a><span class="c">!!</span>
<a name="ln-627"></a><span class="c">!!  They are case-sensitive names.</span>
<a name="ln-628"></a><span class="c">!!</span>
<a name="ln-629"></a><span class="c">!!   LOCATING RESPONSE FILES</span>
<a name="ln-630"></a><span class="c">!!</span>
<a name="ln-631"></a><span class="c">!!  A search for the response file always starts with the current directory.</span>
<a name="ln-632"></a><span class="c">!!  The search then proceeds to look in any additional directories specified</span>
<a name="ln-633"></a><span class="c">!!  with the colon-delimited environment variable CLI_RESPONSE_PATH.</span>
<a name="ln-634"></a><span class="c">!!</span>
<a name="ln-635"></a><span class="c">!!  The first resource file found that results in lines being processed</span>
<a name="ln-636"></a><span class="c">!!  will be used and processing stops after that first match is found. If</span>
<a name="ln-637"></a><span class="c">!!  no match is found an error occurs and the program is stopped.</span>
<a name="ln-638"></a><span class="c">!!</span>
<a name="ln-639"></a><span class="c">!!   RESPONSE FILE SECTIONS</span>
<a name="ln-640"></a><span class="c">!!</span>
<a name="ln-641"></a><span class="c">!!  A simple response file just has options for calling the program in it</span>
<a name="ln-642"></a><span class="c">!!  prefixed with the word &quot;options&quot;.</span>
<a name="ln-643"></a><span class="c">!!  But they can also contain section headers to denote selections that are</span>
<a name="ln-644"></a><span class="c">!!  only executed when a specific OS is being used, print messages, and</span>
<a name="ln-645"></a><span class="c">!!  execute system commands.</span>
<a name="ln-646"></a><span class="c">!!</span>
<a name="ln-647"></a><span class="c">!!   SEARCHING FOR OSTYPE IN REGULAR FILES</span>
<a name="ln-648"></a><span class="c">!!</span>
<a name="ln-649"></a><span class="c">!!  So assuming the name @NAME was specified on the command line a file</span>
<a name="ln-650"></a><span class="c">!!  named NAME.rsp will be searched for in all the search directories</span>
<a name="ln-651"></a><span class="c">!!  and then in that file a string that starts with the string @OSTYPE</span>
<a name="ln-652"></a><span class="c">!!  (if the environment variables $OS and $OSTYPE are not blank. $OSTYPE</span>
<a name="ln-653"></a><span class="c">!!  takes precedence over $OS).</span>
<a name="ln-654"></a><span class="c">!!</span>
<a name="ln-655"></a><span class="c">!!   SEARCHING FOR UNLABELED DIRECTIVES IN REGULAR FILES</span>
<a name="ln-656"></a><span class="c">!!</span>
<a name="ln-657"></a><span class="c">!!  Then, the same files will be searched for lines above any line starting</span>
<a name="ln-658"></a><span class="c">!!  with &quot;@&quot;. That is, if there is no special section for the current OS</span>
<a name="ln-659"></a><span class="c">!!  it just looks at the top of the file for unlabeled options.</span>
<a name="ln-660"></a><span class="c">!!</span>
<a name="ln-661"></a><span class="c">!!   SEARCHING FOR OSTYPE AND NAME IN THE COMPOUND FILE</span>
<a name="ln-662"></a><span class="c">!!</span>
<a name="ln-663"></a><span class="c">!!  In addition or instead of files with the same name as the @NAME option</span>
<a name="ln-664"></a><span class="c">!!  on the command line, you can have one file named after the executable</span>
<a name="ln-665"></a><span class="c">!!  name that contains multiple abbreviation names.</span>
<a name="ln-666"></a><span class="c">!!</span>
<a name="ln-667"></a><span class="c">!!  So if your program executable is named EXEC you create a single file</span>
<a name="ln-668"></a><span class="c">!!  called EXEC.rsp and can append all the simple files described above</span>
<a name="ln-669"></a><span class="c">!!  separating them with lines of the form @OSTYPE@NAME or just @NAME.</span>
<a name="ln-670"></a><span class="c">!!</span>
<a name="ln-671"></a><span class="c">!!  So if no specific file for the abbreviation is found a file called</span>
<a name="ln-672"></a><span class="c">!!  &quot;EXEC.rsp&quot; is searched for where &quot;EXEC&quot; is the name of the executable.</span>
<a name="ln-673"></a><span class="c">!!  This file is always a &quot;compound&quot; response file that uses the following format:</span>
<a name="ln-674"></a><span class="c">!!</span>
<a name="ln-675"></a><span class="c">!!  Any compound EXEC.rsp file found in the current or searched directories</span>
<a name="ln-676"></a><span class="c">!!  will be searched for the string @OSTYPE@NAME first.</span>
<a name="ln-677"></a><span class="c">!!</span>
<a name="ln-678"></a><span class="c">!!  Then if nothing is found, the less specific line @NAME is searched for.</span>
<a name="ln-679"></a><span class="c">!!</span>
<a name="ln-680"></a><span class="c">!!   THE SEARCH IS OVER</span>
<a name="ln-681"></a><span class="c">!!</span>
<a name="ln-682"></a><span class="c">!!  Sounds complicated but actually works quite intuitively. Make a file in</span>
<a name="ln-683"></a><span class="c">!!  the current directory and put options in it and it will be used. If that</span>
<a name="ln-684"></a><span class="c">!!  file ends up needing different cases for different platforms add a line</span>
<a name="ln-685"></a><span class="c">!!  like &quot;@Linux&quot; to the file and some more lines and that will only be</span>
<a name="ln-686"></a><span class="c">!!  executed if the environment variable OSTYPE or OS is &quot;Linux&quot;. If no match</span>
<a name="ln-687"></a><span class="c">!!  is found for named sections the lines at the top before any &quot;@&quot; lines</span>
<a name="ln-688"></a><span class="c">!!  will be used as a default if no match is found.</span>
<a name="ln-689"></a><span class="c">!!</span>
<a name="ln-690"></a><span class="c">!!  If you end up using a lot of files like this you can combine them all</span>
<a name="ln-691"></a><span class="c">!!  together and put them into a file called &quot;program_name&quot;.rsp and just</span>
<a name="ln-692"></a><span class="c">!!  put lines like @NAME or @OSTYPE@NAME at that top of each selection.</span>
<a name="ln-693"></a><span class="c">!!</span>
<a name="ln-694"></a><span class="c">!!  Now, back to the details on just what you can put in the files.</span>
<a name="ln-695"></a><span class="c">!!</span>
<a name="ln-696"></a><span class="c">!!##SPECIFICATION FOR RESPONSE FILES</span>
<a name="ln-697"></a><span class="c">!!</span>
<a name="ln-698"></a><span class="c">!!   SIMPLE RESPONSE FILES</span>
<a name="ln-699"></a><span class="c">!!</span>
<a name="ln-700"></a><span class="c">!!  The first word of a line is special and has the following meanings:</span>
<a name="ln-701"></a><span class="c">!!</span>
<a name="ln-702"></a><span class="c">!!    options|-  Command options following the rules of the SET_ARGS(3f)</span>
<a name="ln-703"></a><span class="c">!!               prototype. So</span>
<a name="ln-704"></a><span class="c">!!                o It is preferred to specify a value for all options.</span>
<a name="ln-705"></a><span class="c">!!                o double-quote strings.</span>
<a name="ln-706"></a><span class="c">!!                o give a blank string value as &quot; &quot;.</span>
<a name="ln-707"></a><span class="c">!!                o use F|T for lists of logicals,</span>
<a name="ln-708"></a><span class="c">!!                o lists of numbers should be comma-delimited.</span>
<a name="ln-709"></a><span class="c">!!    comment|#  Line is a comment line</span>
<a name="ln-710"></a><span class="c">!!    system|!   System command.</span>
<a name="ln-711"></a><span class="c">!!               System commands are executed as a simple call to</span>
<a name="ln-712"></a><span class="c">!!               system (so a cd(1) or setting a shell variable</span>
<a name="ln-713"></a><span class="c">!!               would not effect subsequent lines, for example)</span>
<a name="ln-714"></a><span class="c">!!    print|&gt;    Message to screen</span>
<a name="ln-715"></a><span class="c">!!    stop       display message and stop program.</span>
<a name="ln-716"></a><span class="c">!!</span>
<a name="ln-717"></a><span class="c">!!  So if a program that does nothing but echos its parameters</span>
<a name="ln-718"></a><span class="c">!!</span>
<a name="ln-719"></a><span class="c">!!    program testit</span>
<a name="ln-720"></a><span class="c">!!    use M_CLI2, only : set_args, rget, sget, lget</span>
<a name="ln-721"></a><span class="c">!!    use M_CLI2, only : CLI_response_file</span>
<a name="ln-722"></a><span class="c">!!    implicit none</span>
<a name="ln-723"></a><span class="c">!!       real :: x,y                           ; namelist/args/ x,y</span>
<a name="ln-724"></a><span class="c">!!       character(len=:),allocatable :: title ; namelist/args/ title</span>
<a name="ln-725"></a><span class="c">!!       logical :: big                        ; namelist/args/ big</span>
<a name="ln-726"></a><span class="c">!!       CLI_response_file=.true.</span>
<a name="ln-727"></a><span class="c">!!       call set_args(&#39;-x 10.0 -y 20.0 --title &quot;my title&quot; --big F&#39;)</span>
<a name="ln-728"></a><span class="c">!!       x=rget(&#39;x&#39;)</span>
<a name="ln-729"></a><span class="c">!!       y=rget(&#39;y&#39;)</span>
<a name="ln-730"></a><span class="c">!!       title=sget(&#39;title&#39;)</span>
<a name="ln-731"></a><span class="c">!!       big=lget(&#39;big&#39;)</span>
<a name="ln-732"></a><span class="c">!!       write(*,nml=args)</span>
<a name="ln-733"></a><span class="c">!!    end program testit</span>
<a name="ln-734"></a><span class="c">!!</span>
<a name="ln-735"></a><span class="c">!!  And a file in the current directory called &quot;a.rsp&quot; contains</span>
<a name="ln-736"></a><span class="c">!!</span>
<a name="ln-737"></a><span class="c">!!     # defaults for project A</span>
<a name="ln-738"></a><span class="c">!!     options -x 1000 -y 9999</span>
<a name="ln-739"></a><span class="c">!!     options --title &quot; &quot;</span>
<a name="ln-740"></a><span class="c">!!     options --big T</span>
<a name="ln-741"></a><span class="c">!!</span>
<a name="ln-742"></a><span class="c">!!  The program could be called with</span>
<a name="ln-743"></a><span class="c">!!</span>
<a name="ln-744"></a><span class="c">!!     $myprog     # normal call</span>
<a name="ln-745"></a><span class="c">!!      X=10.0 Y=20.0 TITLE=&quot;my title&quot;</span>
<a name="ln-746"></a><span class="c">!!</span>
<a name="ln-747"></a><span class="c">!!     $myprog @a  # change defaults as specified in &quot;a.rsp&quot;</span>
<a name="ln-748"></a><span class="c">!!     X=1000.0 Y=9999.0 TITLE=&quot; &quot;</span>
<a name="ln-749"></a><span class="c">!!</span>
<a name="ln-750"></a><span class="c">!!     # change defaults but use any option as normal to override defaults</span>
<a name="ln-751"></a><span class="c">!!     $myprog @a -y 1234</span>
<a name="ln-752"></a><span class="c">!!      X=1000.0 Y=1234.0 TITLE=&quot; &quot;</span>
<a name="ln-753"></a><span class="c">!!</span>
<a name="ln-754"></a><span class="c">!!   COMPOUND RESPONSE FILES</span>
<a name="ln-755"></a><span class="c">!!</span>
<a name="ln-756"></a><span class="c">!!  A compound response file has the same basename as the executable with a</span>
<a name="ln-757"></a><span class="c">!!  &quot;.rsp&quot; suffix added. So if your program is named &quot;myprg&quot; the filename</span>
<a name="ln-758"></a><span class="c">!!  must be &quot;myprg.rsp&quot;.</span>
<a name="ln-759"></a><span class="c">!!</span>
<a name="ln-760"></a><span class="c">!!    Note that here `basename` means the last leaf  of the</span>
<a name="ln-761"></a><span class="c">!!    name of the program as returned by the Fortran intrinsic</span>
<a name="ln-762"></a><span class="c">!!    GET_COMMAND_ARGUMENT(0,...) trimmed of anything after a period (&quot;.&quot;),</span>
<a name="ln-763"></a><span class="c">!!    so it is a good idea not to use hidden files.</span>
<a name="ln-764"></a><span class="c">!!</span>
<a name="ln-765"></a><span class="c">!!  Unlike simple response files compound response files can contain multiple</span>
<a name="ln-766"></a><span class="c">!!  setting names.</span>
<a name="ln-767"></a><span class="c">!!</span>
<a name="ln-768"></a><span class="c">!!  Specifically in a compound file</span>
<a name="ln-769"></a><span class="c">!!  if the environment variable $OSTYPE (first) or $OS is set the first search</span>
<a name="ln-770"></a><span class="c">!!  will be for a line of the form (no leading spaces should be used):</span>
<a name="ln-771"></a><span class="c">!!</span>
<a name="ln-772"></a><span class="c">!!    @OSTYPE@alias_name</span>
<a name="ln-773"></a><span class="c">!!</span>
<a name="ln-774"></a><span class="c">!!  If no match or if the environment variables $OSTYPE and $OS were not</span>
<a name="ln-775"></a><span class="c">!!  set or a match is not found then a line of the form</span>
<a name="ln-776"></a><span class="c">!!</span>
<a name="ln-777"></a><span class="c">!!    @alias_name</span>
<a name="ln-778"></a><span class="c">!!</span>
<a name="ln-779"></a><span class="c">!!  is searched for in simple or compound files. If found subsequent lines</span>
<a name="ln-780"></a><span class="c">!!  will be ignored that start with &quot;@&quot; until a line not starting with</span>
<a name="ln-781"></a><span class="c">!!  &quot;@&quot; is encountered. Lines will then be processed until another line</span>
<a name="ln-782"></a><span class="c">!!  starting with &quot;@&quot; is found or end-of-file is encountered.</span>
<a name="ln-783"></a><span class="c">!!</span>
<a name="ln-784"></a><span class="c">!!   COMPOUND RESPONSE FILE EXAMPLE</span>
<a name="ln-785"></a><span class="c">!!  An example compound file</span>
<a name="ln-786"></a><span class="c">!!</span>
<a name="ln-787"></a><span class="c">!!    #################</span>
<a name="ln-788"></a><span class="c">!!    @if</span>
<a name="ln-789"></a><span class="c">!!    &gt; RUNNING TESTS USING RELEASE VERSION AND ifort</span>
<a name="ln-790"></a><span class="c">!!    options test --release --compiler ifort</span>
<a name="ln-791"></a><span class="c">!!    #################</span>
<a name="ln-792"></a><span class="c">!!    @gf</span>
<a name="ln-793"></a><span class="c">!!    &gt; RUNNING TESTS USING RELEASE VERSION AND gfortran</span>
<a name="ln-794"></a><span class="c">!!    options test --release --compiler gfortran</span>
<a name="ln-795"></a><span class="c">!!    #################</span>
<a name="ln-796"></a><span class="c">!!    @nv</span>
<a name="ln-797"></a><span class="c">!!    &gt; RUNNING TESTS USING RELEASE VERSION AND nvfortran</span>
<a name="ln-798"></a><span class="c">!!    options test --release --compiler nvfortran</span>
<a name="ln-799"></a><span class="c">!!    #################</span>
<a name="ln-800"></a><span class="c">!!    @nag</span>
<a name="ln-801"></a><span class="c">!!    &gt; RUNNING TESTS USING RELEASE VERSION AND nagfor</span>
<a name="ln-802"></a><span class="c">!!    options test --release --compiler nagfor</span>
<a name="ln-803"></a><span class="c">!!    #</span>
<a name="ln-804"></a><span class="c">!!    #################</span>
<a name="ln-805"></a><span class="c">!!    # OS-specific example:</span>
<a name="ln-806"></a><span class="c">!!    @Linux@install</span>
<a name="ln-807"></a><span class="c">!!    #</span>
<a name="ln-808"></a><span class="c">!!    # install executables in directory (assuming install(1) exists)</span>
<a name="ln-809"></a><span class="c">!!    #</span>
<a name="ln-810"></a><span class="c">!!    system mkdir -p ~/.local/bin</span>
<a name="ln-811"></a><span class="c">!!    options run --release T --runner &quot;install -vbp -m 0711 -t ~/.local/bin&quot;</span>
<a name="ln-812"></a><span class="c">!!    @install</span>
<a name="ln-813"></a><span class="c">!!    STOP INSTALL NOT SUPPORTED ON THIS PLATFORM OR $OSTYPE NOT SET</span>
<a name="ln-814"></a><span class="c">!!    #</span>
<a name="ln-815"></a><span class="c">!!    #################</span>
<a name="ln-816"></a><span class="c">!!    @fpm@testall</span>
<a name="ln-817"></a><span class="c">!!    #</span>
<a name="ln-818"></a><span class="c">!!    !fpm test --compiler nvfortran</span>
<a name="ln-819"></a><span class="c">!!    !fpm test --compiler ifort</span>
<a name="ln-820"></a><span class="c">!!    !fpm test --compiler gfortran</span>
<a name="ln-821"></a><span class="c">!!    !fpm test --compiler nagfor</span>
<a name="ln-822"></a><span class="c">!!    STOP tests complete. Any additional parameters were ignored</span>
<a name="ln-823"></a><span class="c">!!    #################</span>
<a name="ln-824"></a><span class="c">!!</span>
<a name="ln-825"></a><span class="c">!!  Would be used like</span>
<a name="ln-826"></a><span class="c">!!</span>
<a name="ln-827"></a><span class="c">!!    fpm @install</span>
<a name="ln-828"></a><span class="c">!!    fpm @nag --</span>
<a name="ln-829"></a><span class="c">!!    fpm @testall</span>
<a name="ln-830"></a><span class="c">!!</span>
<a name="ln-831"></a><span class="c">!!   NOTES</span>
<a name="ln-832"></a><span class="c">!!</span>
<a name="ln-833"></a><span class="c">!!    The intel Fortran compiler now calls the response files &quot;indirect</span>
<a name="ln-834"></a><span class="c">!!    files&quot; and does not add the implied suffix &quot;.rsp&quot; to the files</span>
<a name="ln-835"></a><span class="c">!!    anymore. It also allows the @NAME syntax anywhere on the command</span>
<a name="ln-836"></a><span class="c">!!    line, not just at the beginning. --  20201212</span>
<a name="ln-837"></a><span class="c">!!</span>
<a name="ln-838"></a><span class="c">!!##AUTHOR</span>
<a name="ln-839"></a><span class="c">!!      John S. Urban, 2019</span>
<a name="ln-840"></a><span class="c">!!</span>
<a name="ln-841"></a><span class="c">!!##LICENSE</span>
<a name="ln-842"></a><span class="c">!!      Public Domain</span>
<a name="ln-843"></a>
<a name="ln-844"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-845"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-846"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-847"></a><span class="k">subroutine </span><span class="n">set_args</span><span class="p">(</span><span class="n">prototype</span><span class="p">,</span><span class="n">help_text</span><span class="p">,</span><span class="n">version_text</span><span class="p">,</span><span class="n">string</span><span class="p">,</span><span class="n">ierr</span><span class="p">,</span><span class="n">errmsg</span><span class="p">)</span>
<a name="ln-848"></a>
<a name="ln-849"></a><span class="c">! ident_2=&quot;@(#)M_CLI2::set_args(3f): parse prototype string&quot;</span>
<a name="ln-850"></a>
<a name="ln-851"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>                       <span class="kd">::</span> <span class="n">prototype</span>
<a name="ln-852"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>              <span class="kd">::</span> <span class="n">help_text</span><span class="p">(:)</span>
<a name="ln-853"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>              <span class="kd">::</span> <span class="n">version_text</span><span class="p">(:)</span>
<a name="ln-854"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>              <span class="kd">::</span> <span class="n">string</span>
<a name="ln-855"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">),</span><span class="k">optional</span>                      <span class="kd">::</span> <span class="n">ierr</span>
<a name="ln-856"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">),</span><span class="k">allocatable</span><span class="p">,</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">errmsg</span>
<a name="ln-857"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>                      <span class="kd">::</span> <span class="n">hold</span>               <span class="c">! stores command line argument</span>
<a name="ln-858"></a><span class="kt">integer</span>                                           <span class="kd">::</span> <span class="n">ibig</span>
<a name="ln-859"></a>   <span class="n">G_response</span><span class="o">=</span><span class="n">CLI_RESPONSE_FILE</span>
<a name="ln-860"></a>   <span class="n">G_options_only</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>
<a name="ln-861"></a>   <span class="n">G_append</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.</span>
<a name="ln-862"></a>   <span class="n">G_passed_in</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-863"></a>   <span class="n">G_STOP</span><span class="o">=</span><span class="mi">0</span>
<a name="ln-864"></a>   <span class="n">G_STOP_MESSAGE</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-865"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">ierr</span><span class="p">))</span><span class="k">then</span>
<a name="ln-866"></a><span class="k">      </span><span class="n">G_QUIET</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.</span>
<a name="ln-867"></a>   <span class="k">else</span>
<a name="ln-868"></a><span class="k">      </span><span class="n">G_QUIET</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>
<a name="ln-869"></a>   <span class="k">endif</span>
<a name="ln-870"></a><span class="k">   </span><span class="n">ibig</span><span class="o">=</span><span class="n">longest_command_argument</span><span class="p">()</span> <span class="c">! bug in gfortran. len=0 should be fine</span>
<a name="ln-871"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">unnamed</span><span class="p">))</span> <span class="k">deallocate</span><span class="p">(</span><span class="n">unnamed</span><span class="p">)</span>
<a name="ln-872"></a>   <span class="k">allocate</span><span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="n">ibig</span><span class="p">)</span> <span class="kd">::</span> <span class="n">unnamed</span><span class="p">(</span><span class="mi">0</span><span class="p">))</span>
<a name="ln-873"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">args</span><span class="p">))</span> <span class="k">deallocate</span><span class="p">(</span><span class="n">args</span><span class="p">)</span>
<a name="ln-874"></a>   <span class="k">allocate</span><span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="n">ibig</span><span class="p">)</span> <span class="kd">::</span> <span class="n">args</span><span class="p">(</span><span class="mi">0</span><span class="p">))</span>
<a name="ln-875"></a>
<a name="ln-876"></a>   <span class="k">call </span><span class="n">wipe_dictionary</span><span class="p">()</span>
<a name="ln-877"></a>   <span class="n">hold</span><span class="o">=</span><span class="s1">&#39;--version F --usage F --help F --version F &#39;</span><span class="o">//</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">prototype</span><span class="p">)</span>
<a name="ln-878"></a>   <span class="k">call </span><span class="n">prototype_and_cmd_args_to_nlist</span><span class="p">(</span><span class="n">hold</span><span class="p">,</span><span class="n">string</span><span class="p">)</span>
<a name="ln-879"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">G_RESPONSE_IGNORED</span><span class="p">))</span><span class="k">then</span>
<a name="ln-880"></a><span class="k">      if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;SET_ARGS:G_RESPONSE_IGNORED:&#39;</span><span class="p">,</span><span class="n">G_RESPONSE_IGNORED</span>
<a name="ln-881"></a>      <span class="k">if</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">unnamed</span><span class="p">).</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="o">*</span><span class="p">)</span><span class="s1">&#39;LOGIC ERROR&#39;</span>
<a name="ln-882"></a>      <span class="k">call </span><span class="n">split</span><span class="p">(</span><span class="n">G_RESPONSE_IGNORED</span><span class="p">,</span><span class="n">unnamed</span><span class="p">)</span>
<a name="ln-883"></a>   <span class="k">endif</span>
<a name="ln-884"></a>
<a name="ln-885"></a><span class="k">   if</span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="nb">allocated</span><span class="p">(</span><span class="n">unnamed</span><span class="p">))</span><span class="k">then</span>
<a name="ln-886"></a><span class="k">       allocate</span><span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">0</span><span class="p">)</span> <span class="kd">::</span> <span class="n">unnamed</span><span class="p">(</span><span class="mi">0</span><span class="p">))</span>
<a name="ln-887"></a>   <span class="k">endif</span>
<a name="ln-888"></a><span class="k">   if</span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="nb">allocated</span><span class="p">(</span><span class="n">args</span><span class="p">))</span><span class="k">then</span>
<a name="ln-889"></a><span class="k">       allocate</span><span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">0</span><span class="p">)</span> <span class="kd">::</span> <span class="n">args</span><span class="p">(</span><span class="mi">0</span><span class="p">))</span>
<a name="ln-890"></a>   <span class="k">endif</span>
<a name="ln-891"></a><span class="k">   call </span><span class="n">check_commandline</span><span class="p">(</span><span class="n">help_text</span><span class="p">,</span><span class="n">version_text</span><span class="p">)</span> <span class="c">! process --help, --version, --usage</span>
<a name="ln-892"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">ierr</span><span class="p">))</span><span class="k">then</span>
<a name="ln-893"></a><span class="k">      </span><span class="n">ierr</span><span class="o">=</span><span class="n">G_STOP</span>
<a name="ln-894"></a>   <span class="k">endif</span>
<a name="ln-895"></a><span class="k">   if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">errmsg</span><span class="p">))</span><span class="k">then</span>
<a name="ln-896"></a><span class="k">      </span><span class="n">errmsg</span><span class="o">=</span><span class="n">G_STOP_MESSAGE</span>
<a name="ln-897"></a>   <span class="k">endif</span>
<a name="ln-898"></a><span class="k">end subroutine </span><span class="n">set_args</span>
<a name="ln-899"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-900"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-901"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-902"></a><span class="c">!&gt;</span>
<a name="ln-903"></a><span class="c">!!##NAME</span>
<a name="ln-904"></a><span class="c">!!    get_subcommand(3f) - [ARGUMENTS:M_CLI2] special-case routine for</span>
<a name="ln-905"></a><span class="c">!!    handling subcommands on a command line</span>
<a name="ln-906"></a><span class="c">!!    (LICENSE:PD)</span>
<a name="ln-907"></a><span class="c">!!</span>
<a name="ln-908"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-909"></a><span class="c">!!</span>
<a name="ln-910"></a><span class="c">!!    function get_subcommand()</span>
<a name="ln-911"></a><span class="c">!!</span>
<a name="ln-912"></a><span class="c">!!     character(len=:),allocatable :: get_subcommand</span>
<a name="ln-913"></a><span class="c">!!</span>
<a name="ln-914"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-915"></a><span class="c">!!    In the special case when creating a program with subcommands it</span>
<a name="ln-916"></a><span class="c">!!    is assumed the first word on the command line is the subcommand. A</span>
<a name="ln-917"></a><span class="c">!!    routine is required to handle response file processing, therefore</span>
<a name="ln-918"></a><span class="c">!!    this routine (optionally processing response files) returns that</span>
<a name="ln-919"></a><span class="c">!!    first word as the subcommand name.</span>
<a name="ln-920"></a><span class="c">!!</span>
<a name="ln-921"></a><span class="c">!!    It should not be used by programs not building a more elaborate</span>
<a name="ln-922"></a><span class="c">!!    command with subcommands.</span>
<a name="ln-923"></a><span class="c">!!</span>
<a name="ln-924"></a><span class="c">!!##RETURNS</span>
<a name="ln-925"></a><span class="c">!!    NAME   name of subcommand</span>
<a name="ln-926"></a><span class="c">!!</span>
<a name="ln-927"></a><span class="c">!!##EXAMPLE</span>
<a name="ln-928"></a><span class="c">!!</span>
<a name="ln-929"></a><span class="c">!! Sample program:</span>
<a name="ln-930"></a><span class="c">!!</span>
<a name="ln-931"></a><span class="c">!!    program demo_get_subcommand</span>
<a name="ln-932"></a><span class="c">!!    !x! SUBCOMMANDS</span>
<a name="ln-933"></a><span class="c">!!    !x! For a command with subcommands like git(1)</span>
<a name="ln-934"></a><span class="c">!!    !x! you can make separate namelists for each subcommand.</span>
<a name="ln-935"></a><span class="c">!!    !x! You can call this program which has two subcommands (run, test),</span>
<a name="ln-936"></a><span class="c">!!    !x! like this:</span>
<a name="ln-937"></a><span class="c">!!    !x!    demo_get_subcommand --help</span>
<a name="ln-938"></a><span class="c">!!    !x!    demo_get_subcommand run -x -y -z -title -l -L</span>
<a name="ln-939"></a><span class="c">!!    !x!    demo_get_subcommand test -title -l -L -testname</span>
<a name="ln-940"></a><span class="c">!!    !x!    demo_get_subcommand run --help</span>
<a name="ln-941"></a><span class="c">!!       implicit none</span>
<a name="ln-942"></a><span class="c">!!    !x! DEFINE VALUES TO USE AS ARGUMENTS WITH INITIAL VALUES</span>
<a name="ln-943"></a><span class="c">!!       real               :: x=-999.0,y=-999.0,z=-999.0</span>
<a name="ln-944"></a><span class="c">!!       character(len=80)  :: title=&quot;not set&quot;</span>
<a name="ln-945"></a><span class="c">!!       logical            :: l=.false.</span>
<a name="ln-946"></a><span class="c">!!       logical            :: l_=.false.</span>
<a name="ln-947"></a><span class="c">!!       character(len=80)  :: testname=&quot;not set&quot;</span>
<a name="ln-948"></a><span class="c">!!       character(len=20)  :: name</span>
<a name="ln-949"></a><span class="c">!!       call parse(name) !x! DEFINE AND PARSE COMMAND LINE</span>
<a name="ln-950"></a><span class="c">!!       !x! ALL DONE CRACKING THE COMMAND LINE.</span>
<a name="ln-951"></a><span class="c">!!       !x! USE THE VALUES IN YOUR PROGRAM.</span>
<a name="ln-952"></a><span class="c">!!       write(*,*)&#39;command was &#39;,name</span>
<a name="ln-953"></a><span class="c">!!       write(*,*)&#39;x,y,z .... &#39;,x,y,z</span>
<a name="ln-954"></a><span class="c">!!       write(*,*)&#39;title .... &#39;,title</span>
<a name="ln-955"></a><span class="c">!!       write(*,*)&#39;l,l_ ..... &#39;,l,l_</span>
<a name="ln-956"></a><span class="c">!!       write(*,*)&#39;testname . &#39;,testname</span>
<a name="ln-957"></a><span class="c">!!    contains</span>
<a name="ln-958"></a><span class="c">!!    subroutine parse(name)</span>
<a name="ln-959"></a><span class="c">!!    !x! PUT EVERYTHING TO DO WITH COMMAND PARSING HERE FOR CLARITY</span>
<a name="ln-960"></a><span class="c">!!    use M_CLI2, only : set_args, get_args, get_args_fixed_length</span>
<a name="ln-961"></a><span class="c">!!    use M_CLI2, only : get_subcommand</span>
<a name="ln-962"></a><span class="c">!!    use M_CLI2, only : CLI_RESPONSE_FILE</span>
<a name="ln-963"></a><span class="c">!!    character(len=*)              :: name    ! the subcommand name</span>
<a name="ln-964"></a><span class="c">!!    character(len=:),allocatable  :: help_text(:), version_text(:)</span>
<a name="ln-965"></a><span class="c">!!       CLI_RESPONSE_FILE=.true.</span>
<a name="ln-966"></a><span class="c">!!    ! define version text</span>
<a name="ln-967"></a><span class="c">!!       version_text=[character(len=80) :: &amp;</span>
<a name="ln-968"></a><span class="c">!!          &#39;@(#)PROGRAM:     demo_get_subcommand            &gt;&#39;, &amp;</span>
<a name="ln-969"></a><span class="c">!!          &#39;@(#)DESCRIPTION: My demo program  &gt;&#39;, &amp;</span>
<a name="ln-970"></a><span class="c">!!          &#39;@(#)VERSION:     1.0 20200715     &gt;&#39;, &amp;</span>
<a name="ln-971"></a><span class="c">!!          &#39;@(#)AUTHOR:      me, myself, and I&gt;&#39;, &amp;</span>
<a name="ln-972"></a><span class="c">!!          &#39;@(#)LICENSE:     Public Domain    &gt;&#39;, &amp;</span>
<a name="ln-973"></a><span class="c">!!          &#39;&#39; ]</span>
<a name="ln-974"></a><span class="c">!!        ! general help for &quot;demo_get_subcommand --help&quot;</span>
<a name="ln-975"></a><span class="c">!!        help_text=[character(len=80) :: &amp;</span>
<a name="ln-976"></a><span class="c">!!         &#39; allowed subcommands are          &#39;, &amp;</span>
<a name="ln-977"></a><span class="c">!!         &#39;   * run  -l -L -title -x -y -z   &#39;, &amp;</span>
<a name="ln-978"></a><span class="c">!!         &#39;   * test -l -L -title            &#39;, &amp;</span>
<a name="ln-979"></a><span class="c">!!         &#39;&#39; ]</span>
<a name="ln-980"></a><span class="c">!!       ! find the subcommand name by looking for first word on command</span>
<a name="ln-981"></a><span class="c">!!       ! not starting with dash</span>
<a name="ln-982"></a><span class="c">!!       name = get_subcommand()</span>
<a name="ln-983"></a><span class="c">!!       select case(name)</span>
<a name="ln-984"></a><span class="c">!!       case(&#39;run&#39;)</span>
<a name="ln-985"></a><span class="c">!!        help_text=[character(len=80) :: &amp;</span>
<a name="ln-986"></a><span class="c">!!         &#39;                                  &#39;, &amp;</span>
<a name="ln-987"></a><span class="c">!!         &#39; Help for subcommand &quot;run&quot;        &#39;, &amp;</span>
<a name="ln-988"></a><span class="c">!!         &#39;                                  &#39;, &amp;</span>
<a name="ln-989"></a><span class="c">!!         &#39;&#39; ]</span>
<a name="ln-990"></a><span class="c">!!        call set_args( &amp;</span>
<a name="ln-991"></a><span class="c">!!        &amp; &#39;-x 1 -y 2 -z 3 --title &quot;my title&quot; -l F -L F&#39;,&amp;</span>
<a name="ln-992"></a><span class="c">!!        &amp; help_text,version_text)</span>
<a name="ln-993"></a><span class="c">!!        call get_args(&#39;x&#39;,x)</span>
<a name="ln-994"></a><span class="c">!!        call get_args(&#39;y&#39;,y)</span>
<a name="ln-995"></a><span class="c">!!        call get_args(&#39;z&#39;,z)</span>
<a name="ln-996"></a><span class="c">!!        call get_args_fixed_length(&#39;title&#39;,title)</span>
<a name="ln-997"></a><span class="c">!!        call get_args(&#39;l&#39;,l)</span>
<a name="ln-998"></a><span class="c">!!        call get_args(&#39;L&#39;,l_)</span>
<a name="ln-999"></a><span class="c">!!       case(&#39;test&#39;)</span>
<a name="ln-1000"></a><span class="c">!!        help_text=[character(len=80) :: &amp;</span>
<a name="ln-1001"></a><span class="c">!!         &#39;                                  &#39;, &amp;</span>
<a name="ln-1002"></a><span class="c">!!         &#39; Help for subcommand &quot;test&quot;       &#39;, &amp;</span>
<a name="ln-1003"></a><span class="c">!!         &#39;                                  &#39;, &amp;</span>
<a name="ln-1004"></a><span class="c">!!         &#39;&#39; ]</span>
<a name="ln-1005"></a><span class="c">!!        call set_args(&amp;</span>
<a name="ln-1006"></a><span class="c">!!        &amp; &#39;--title &quot;my title&quot; -l F -L F --testname &quot;Test&quot;&#39;,&amp;</span>
<a name="ln-1007"></a><span class="c">!!        &amp; help_text,version_text)</span>
<a name="ln-1008"></a><span class="c">!!        call get_args_fixed_length(&#39;title&#39;,title)</span>
<a name="ln-1009"></a><span class="c">!!        call get_args(&#39;l&#39;,l)</span>
<a name="ln-1010"></a><span class="c">!!        call get_args(&#39;L&#39;,l_)</span>
<a name="ln-1011"></a><span class="c">!!        call get_args_fixed_length(&#39;testname&#39;,testname)</span>
<a name="ln-1012"></a><span class="c">!!       case default</span>
<a name="ln-1013"></a><span class="c">!!        ! process help and version</span>
<a name="ln-1014"></a><span class="c">!!        call set_args(&#39; &#39;,help_text,version_text)</span>
<a name="ln-1015"></a><span class="c">!!        write(*,&#39;(*(a))&#39;)&#39;unknown or missing subcommand [&#39;,trim(name),&#39;]&#39;</span>
<a name="ln-1016"></a><span class="c">!!        write(*,&#39;(a)&#39;)[character(len=80) ::  &amp;</span>
<a name="ln-1017"></a><span class="c">!!        &#39; allowed subcommands are          &#39;, &amp;</span>
<a name="ln-1018"></a><span class="c">!!        &#39;   * run  -l -L -title -x -y -z   &#39;, &amp;</span>
<a name="ln-1019"></a><span class="c">!!        &#39;   * test -l -L -title            &#39;, &amp;</span>
<a name="ln-1020"></a><span class="c">!!        &#39;&#39; ]</span>
<a name="ln-1021"></a><span class="c">!!        stop</span>
<a name="ln-1022"></a><span class="c">!!       end select</span>
<a name="ln-1023"></a><span class="c">!!    end subroutine parse</span>
<a name="ln-1024"></a><span class="c">!!    end program demo_get_subcommand</span>
<a name="ln-1025"></a><span class="c">!!</span>
<a name="ln-1026"></a><span class="c">!!##AUTHOR</span>
<a name="ln-1027"></a><span class="c">!!      John S. Urban, 2019</span>
<a name="ln-1028"></a><span class="c">!!</span>
<a name="ln-1029"></a><span class="c">!!##LICENSE</span>
<a name="ln-1030"></a><span class="c">!!      Public Domain</span>
<a name="ln-1031"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1032"></a><span class="k">function </span><span class="n">get_subcommand</span><span class="p">()</span> <span class="k">result</span><span class="p">(</span><span class="n">sub</span><span class="p">)</span>
<a name="ln-1033"></a>
<a name="ln-1034"></a><span class="c">! ident_3=&quot;@(#)M_CLI2::get_subcommand(3f): parse prototype string to get subcommand, allowing for response files&quot;</span>
<a name="ln-1035"></a>
<a name="ln-1036"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>  <span class="kd">::</span> <span class="n">sub</span>
<a name="ln-1037"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>  <span class="kd">::</span> <span class="n">cmdarg</span>
<a name="ln-1038"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>  <span class="kd">::</span> <span class="k">array</span><span class="p">(:)</span>
<a name="ln-1039"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>  <span class="kd">::</span> <span class="n">prototype</span>
<a name="ln-1040"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">ilongest</span>
<a name="ln-1041"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">i</span>
<a name="ln-1042"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">j</span>
<a name="ln-1043"></a>   <span class="n">G_subcommand</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-1044"></a>   <span class="n">G_options_only</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.</span>
<a name="ln-1045"></a>   <span class="n">sub</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-1046"></a>
<a name="ln-1047"></a>   <span class="k">if</span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="nb">allocated</span><span class="p">(</span><span class="n">unnamed</span><span class="p">))</span><span class="k">then</span>
<a name="ln-1048"></a><span class="k">      allocate</span><span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">0</span><span class="p">)</span> <span class="kd">::</span> <span class="n">unnamed</span><span class="p">(</span><span class="mi">0</span><span class="p">))</span>
<a name="ln-1049"></a>   <span class="k">endif</span>
<a name="ln-1050"></a>
<a name="ln-1051"></a><span class="k">   </span><span class="n">ilongest</span><span class="o">=</span><span class="n">longest_command_argument</span><span class="p">()</span>
<a name="ln-1052"></a>   <span class="k">allocate</span><span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="nb">max</span><span class="p">(</span><span class="mi">63</span><span class="p">,</span><span class="n">ilongest</span><span class="p">))</span><span class="kd">::</span> <span class="n">cmdarg</span><span class="p">)</span>
<a name="ln-1053"></a>   <span class="n">cmdarg</span><span class="p">(:)</span> <span class="o">=</span> <span class="s1">&#39;&#39;</span>
<a name="ln-1054"></a>   <span class="c">! look for @NAME if CLI_RESPONSE_FILE=.TRUE. AND LOAD THEM</span>
<a name="ln-1055"></a>   <span class="k">do </span><span class="n">i</span> <span class="o">=</span> <span class="mi">1</span><span class="p">,</span> <span class="nb">command_argument_count</span><span class="p">()</span>
<a name="ln-1056"></a>      <span class="k">call </span><span class="nb">get_command_argument</span><span class="p">(</span><span class="n">i</span><span class="p">,</span> <span class="n">cmdarg</span><span class="p">)</span>
<a name="ln-1057"></a>      <span class="k">if</span><span class="p">(</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">cmdarg</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="mi">1</span><span class="p">))</span> <span class="p">.</span><span class="n">eq</span><span class="p">.</span> <span class="s1">&#39;@&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1058"></a><span class="k">         call </span><span class="n">get_prototype</span><span class="p">(</span><span class="n">cmdarg</span><span class="p">,</span><span class="n">prototype</span><span class="p">)</span>
<a name="ln-1059"></a>         <span class="k">call </span><span class="n">split</span><span class="p">(</span><span class="n">prototype</span><span class="p">,</span><span class="k">array</span><span class="p">)</span>
<a name="ln-1060"></a>         <span class="c">! assume that if using subcommands first word not starting with dash is the subcommand</span>
<a name="ln-1061"></a>         <span class="k">do </span><span class="n">j</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="k">array</span><span class="p">)</span>
<a name="ln-1062"></a>            <span class="k">if</span><span class="p">(</span><span class="nb">adjustl</span><span class="p">(</span><span class="k">array</span><span class="p">(</span><span class="n">j</span><span class="p">)(</span><span class="mi">1</span><span class="p">:</span><span class="mi">1</span><span class="p">))</span> <span class="p">.</span><span class="n">ne</span><span class="p">.</span> <span class="s1">&#39;-&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1063"></a><span class="k">            </span><span class="n">G_subcommand</span><span class="o">=</span><span class="nb">trim</span><span class="p">(</span><span class="k">array</span><span class="p">(</span><span class="n">j</span><span class="p">))</span>
<a name="ln-1064"></a>            <span class="n">sub</span><span class="o">=</span><span class="n">G_subcommand</span>
<a name="ln-1065"></a>            <span class="k">exit</span>
<a name="ln-1066"></a><span class="k">         endif</span>
<a name="ln-1067"></a><span class="k">         enddo</span>
<a name="ln-1068"></a><span class="k">      endif</span>
<a name="ln-1069"></a><span class="k">   enddo</span>
<a name="ln-1070"></a>
<a name="ln-1071"></a><span class="k">   if</span><span class="p">(</span><span class="n">G_subcommand</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39;&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1072"></a><span class="k">      </span><span class="n">sub</span><span class="o">=</span><span class="n">G_subcommand</span>
<a name="ln-1073"></a>   <span class="n">elseif</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">unnamed</span><span class="p">).</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1074"></a><span class="k">      </span><span class="n">sub</span><span class="o">=</span><span class="n">unnamed</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span>
<a name="ln-1075"></a>   <span class="k">else</span>
<a name="ln-1076"></a><span class="k">      </span><span class="n">cmdarg</span><span class="p">(:)</span> <span class="o">=</span> <span class="s1">&#39;&#39;</span>
<a name="ln-1077"></a>      <span class="k">do </span><span class="n">i</span> <span class="o">=</span> <span class="mi">1</span><span class="p">,</span> <span class="nb">command_argument_count</span><span class="p">()</span>
<a name="ln-1078"></a>         <span class="k">call </span><span class="nb">get_command_argument</span><span class="p">(</span><span class="n">i</span><span class="p">,</span> <span class="n">cmdarg</span><span class="p">)</span>
<a name="ln-1079"></a>         <span class="k">if</span><span class="p">(</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">cmdarg</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="mi">1</span><span class="p">))</span> <span class="p">.</span><span class="n">ne</span><span class="p">.</span> <span class="s1">&#39;-&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1080"></a><span class="k">            </span><span class="n">sub</span><span class="o">=</span><span class="nb">trim</span><span class="p">(</span><span class="n">cmdarg</span><span class="p">)</span>
<a name="ln-1081"></a>           <span class="k">exit</span>
<a name="ln-1082"></a><span class="k">        endif</span>
<a name="ln-1083"></a><span class="k">      enddo</span>
<a name="ln-1084"></a><span class="k">   endif</span>
<a name="ln-1085"></a><span class="k">   </span><span class="n">G_options_only</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>
<a name="ln-1086"></a><span class="k">end function </span><span class="n">get_subcommand</span>
<a name="ln-1087"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1088"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-1089"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1090"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1091"></a><span class="k">subroutine </span><span class="n">set_usage</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">description</span><span class="p">,</span><span class="k">value</span><span class="p">)</span>
<a name="ln-1092"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">keyword</span>
<a name="ln-1093"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">description</span>
<a name="ln-1094"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="k">value</span>
<a name="ln-1095"></a><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="o">*</span><span class="p">)</span><span class="n">keyword</span>
<a name="ln-1096"></a><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="o">*</span><span class="p">)</span><span class="n">description</span>
<a name="ln-1097"></a><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="o">*</span><span class="p">)</span><span class="k">value</span>
<a name="ln-1098"></a><span class="c">! store the descriptions in an array and then apply them when set_args(3f) is called.</span>
<a name="ln-1099"></a><span class="c">! alternatively, could allow for a value as well in lieue of the prototype</span>
<a name="ln-1100"></a><span class="k">end subroutine </span><span class="n">set_usage</span>
<a name="ln-1101"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1102"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-1103"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1104"></a><span class="c">!&gt;</span>
<a name="ln-1105"></a><span class="c">!!##NAME</span>
<a name="ln-1106"></a><span class="c">!!      prototype_to_dictionary(3f) - [ARGUMENTS:M_CLI2] parse user command</span>
<a name="ln-1107"></a><span class="c">!!      and store tokens into dictionary</span>
<a name="ln-1108"></a><span class="c">!!      (LICENSE:PD)</span>
<a name="ln-1109"></a><span class="c">!!</span>
<a name="ln-1110"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-1111"></a><span class="c">!!</span>
<a name="ln-1112"></a><span class="c">!!     recursive subroutine prototype_to_dictionary(string)</span>
<a name="ln-1113"></a><span class="c">!!</span>
<a name="ln-1114"></a><span class="c">!!      character(len=*),intent(in)     ::  string</span>
<a name="ln-1115"></a><span class="c">!!</span>
<a name="ln-1116"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-1117"></a><span class="c">!!      given a string of form</span>
<a name="ln-1118"></a><span class="c">!!</span>
<a name="ln-1119"></a><span class="c">!!        -var value -var value</span>
<a name="ln-1120"></a><span class="c">!!</span>
<a name="ln-1121"></a><span class="c">!!      define dictionary of form</span>
<a name="ln-1122"></a><span class="c">!!</span>
<a name="ln-1123"></a><span class="c">!!        keyword(i), value(i)</span>
<a name="ln-1124"></a><span class="c">!!</span>
<a name="ln-1125"></a><span class="c">!!      o  string values</span>
<a name="ln-1126"></a><span class="c">!!</span>
<a name="ln-1127"></a><span class="c">!!          o must be delimited with double quotes.</span>
<a name="ln-1128"></a><span class="c">!!          o adjacent double quotes put one double quote into value</span>
<a name="ln-1129"></a><span class="c">!!          o must not be null. A blank is specified as &quot; &quot;, not &quot;&quot;.</span>
<a name="ln-1130"></a><span class="c">!!</span>
<a name="ln-1131"></a><span class="c">!!      o  logical values</span>
<a name="ln-1132"></a><span class="c">!!</span>
<a name="ln-1133"></a><span class="c">!!          o logical values must have a value</span>
<a name="ln-1134"></a><span class="c">!!</span>
<a name="ln-1135"></a><span class="c">!!      o  leading and trailing blanks are removed from unquoted values</span>
<a name="ln-1136"></a><span class="c">!!</span>
<a name="ln-1137"></a><span class="c">!!</span>
<a name="ln-1138"></a><span class="c">!!##OPTIONS</span>
<a name="ln-1139"></a><span class="c">!!      STRING   string is character input string to define command</span>
<a name="ln-1140"></a><span class="c">!!</span>
<a name="ln-1141"></a><span class="c">!!##RETURNS</span>
<a name="ln-1142"></a><span class="c">!!</span>
<a name="ln-1143"></a><span class="c">!!##EXAMPLE</span>
<a name="ln-1144"></a><span class="c">!!</span>
<a name="ln-1145"></a><span class="c">!! sample program:</span>
<a name="ln-1146"></a><span class="c">!!</span>
<a name="ln-1147"></a><span class="c">!!     Results:</span>
<a name="ln-1148"></a><span class="c">!!</span>
<a name="ln-1149"></a><span class="c">!!##AUTHOR</span>
<a name="ln-1150"></a><span class="c">!!      John S. Urban, 2019</span>
<a name="ln-1151"></a><span class="c">!!##LICENSE</span>
<a name="ln-1152"></a><span class="c">!!      Public Domain</span>
<a name="ln-1153"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1154"></a><span class="k">recursive subroutine </span><span class="n">prototype_to_dictionary</span><span class="p">(</span><span class="n">string</span><span class="p">)</span>
<a name="ln-1155"></a><span class="k">implicit none</span>
<a name="ln-1156"></a>
<a name="ln-1157"></a><span class="c">! ident_4=&quot;@(#)M_CLI2::prototype_to_dictionary(3f): parse user command and store tokens into dictionary&quot;</span>
<a name="ln-1158"></a>
<a name="ln-1159"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>       <span class="kd">::</span> <span class="n">string</span> <span class="c">! string is character input string of options and values</span>
<a name="ln-1160"></a>
<a name="ln-1161"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>      <span class="kd">::</span> <span class="n">dummy</span>   <span class="c">! working copy of string</span>
<a name="ln-1162"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>      <span class="kd">::</span> <span class="k">value</span>
<a name="ln-1163"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>      <span class="kd">::</span> <span class="n">keyword</span>
<a name="ln-1164"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">3</span><span class="p">)</span>                  <span class="kd">::</span> <span class="n">delmt</span>   <span class="c">! flag if in a delimited string or not</span>
<a name="ln-1165"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">1</span><span class="p">)</span>                  <span class="kd">::</span> <span class="n">currnt</span>  <span class="c">! current character being processed</span>
<a name="ln-1166"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">1</span><span class="p">)</span>                  <span class="kd">::</span> <span class="n">prev</span>    <span class="c">! character to left of CURRNT</span>
<a name="ln-1167"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">1</span><span class="p">)</span>                  <span class="kd">::</span> <span class="n">forwrd</span>  <span class="c">! character to right of CURRNT</span>
<a name="ln-1168"></a><span class="kt">integer</span><span class="p">,</span><span class="k">dimension</span><span class="p">(</span><span class="mi">2</span><span class="p">)</span>              <span class="kd">::</span> <span class="n">ipnt</span>
<a name="ln-1169"></a><span class="kt">integer</span>                           <span class="kd">::</span> <span class="n">islen</span>   <span class="c">! number of characters in input string</span>
<a name="ln-1170"></a><span class="kt">integer</span>                           <span class="kd">::</span> <span class="n">ipoint</span>
<a name="ln-1171"></a><span class="kt">integer</span>                           <span class="kd">::</span> <span class="n">itype</span>
<a name="ln-1172"></a><span class="kt">integer</span><span class="p">,</span><span class="k">parameter</span>                 <span class="kd">::</span> <span class="n">VAL</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span> <span class="n">KEYW</span><span class="o">=</span><span class="mi">2</span>
<a name="ln-1173"></a><span class="kt">integer</span>                           <span class="kd">::</span> <span class="n">ifwd</span>
<a name="ln-1174"></a><span class="kt">integer</span>                           <span class="kd">::</span> <span class="n">ibegin</span>
<a name="ln-1175"></a><span class="kt">integer</span>                           <span class="kd">::</span> <span class="n">iend</span>
<a name="ln-1176"></a><span class="kt">integer</span>                           <span class="kd">::</span> <span class="n">place</span>
<a name="ln-1177"></a>
<a name="ln-1178"></a>   <span class="n">islen</span><span class="o">=</span><span class="nb">len_trim</span><span class="p">(</span><span class="n">string</span><span class="p">)</span>                               <span class="c">! find number of characters in input string</span>
<a name="ln-1179"></a>   <span class="k">if</span><span class="p">(</span><span class="n">islen</span>  <span class="o">==</span>  <span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                 <span class="c">! if input string is blank, even default variable will not be changed</span>
<a name="ln-1180"></a>      <span class="k">return</span>
<a name="ln-1181"></a><span class="k">   endif</span>
<a name="ln-1182"></a><span class="k">   </span><span class="n">dummy</span><span class="o">=</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">string</span><span class="p">)</span><span class="o">//</span><span class="s1">&#39;  &#39;</span>
<a name="ln-1183"></a>
<a name="ln-1184"></a>   <span class="n">keyword</span><span class="o">=</span><span class="s2">&quot;&quot;</span>          <span class="c">! initial variable name</span>
<a name="ln-1185"></a>   <span class="k">value</span><span class="o">=</span><span class="s2">&quot;&quot;</span>            <span class="c">! initial value of a string</span>
<a name="ln-1186"></a>   <span class="n">ipoint</span><span class="o">=</span><span class="mi">0</span>            <span class="c">! ipoint is the current character pointer for (dummy)</span>
<a name="ln-1187"></a>   <span class="n">ipnt</span><span class="p">(</span><span class="mi">2</span><span class="p">)</span><span class="o">=</span><span class="mi">2</span>           <span class="c">! pointer to position in keyword</span>
<a name="ln-1188"></a>   <span class="n">ipnt</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="o">=</span><span class="mi">1</span>           <span class="c">! pointer to position in value</span>
<a name="ln-1189"></a>   <span class="n">itype</span><span class="o">=</span><span class="n">VAL</span>           <span class="c">! itype=1 for value, itype=2 for variable</span>
<a name="ln-1190"></a>
<a name="ln-1191"></a>   <span class="n">delmt</span><span class="o">=</span><span class="s2">&quot;off&quot;</span>
<a name="ln-1192"></a>   <span class="n">prev</span><span class="o">=</span><span class="s2">&quot; &quot;</span>
<a name="ln-1193"></a>
<a name="ln-1194"></a>   <span class="n">G_keyword_single_letter</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.</span>
<a name="ln-1195"></a>   <span class="k">do</span>
<a name="ln-1196"></a><span class="k">      </span><span class="n">ipoint</span><span class="o">=</span><span class="n">ipoint</span><span class="o">+</span><span class="mi">1</span>               <span class="c">! move current character pointer forward</span>
<a name="ln-1197"></a>      <span class="n">currnt</span><span class="o">=</span><span class="n">dummy</span><span class="p">(</span><span class="n">ipoint</span><span class="p">:</span><span class="n">ipoint</span><span class="p">)</span>   <span class="c">! store current character into currnt</span>
<a name="ln-1198"></a>      <span class="n">ifwd</span><span class="o">=</span><span class="nb">min</span><span class="p">(</span><span class="n">ipoint</span><span class="o">+</span><span class="mi">1</span><span class="p">,</span><span class="n">islen</span><span class="p">)</span>      <span class="c">! ensure not past end of string</span>
<a name="ln-1199"></a>      <span class="n">forwrd</span><span class="o">=</span><span class="n">dummy</span><span class="p">(</span><span class="n">ifwd</span><span class="p">:</span><span class="n">ifwd</span><span class="p">)</span>       <span class="c">! next character (or duplicate if last)</span>
<a name="ln-1200"></a>
<a name="ln-1201"></a>      <span class="k">if</span><span class="p">((</span><span class="n">currnt</span><span class="o">==</span><span class="s2">&quot;-&quot;</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="n">prev</span><span class="o">==</span><span class="s2">&quot; &quot;</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="n">delmt</span> <span class="o">==</span> <span class="s2">&quot;off&quot;</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="nb">index</span><span class="p">(</span><span class="s2">&quot;0123456789.&quot;</span><span class="p">,</span><span class="n">forwrd</span><span class="p">)</span> <span class="o">==</span> <span class="mi">0</span><span class="p">).</span><span class="nb">or</span><span class="p">.</span><span class="n">ipoint</span> <span class="o">&gt;</span> <span class="n">islen</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1202"></a>         <span class="c">! beginning of a keyword</span>
<a name="ln-1203"></a>         <span class="k">if</span><span class="p">(</span><span class="n">forwrd</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="s1">&#39;-&#39;</span><span class="p">)</span><span class="k">then</span>                      <span class="c">! change --var to -var so &quot;long&quot; syntax is supported</span>
<a name="ln-1204"></a>            <span class="c">!x!dummy(ifwd:ifwd)=&#39;_&#39;</span>
<a name="ln-1205"></a>            <span class="n">ipoint</span><span class="o">=</span><span class="n">ipoint</span><span class="o">+</span><span class="mi">1</span>                         <span class="c">! ignore second - instead (was changing it to _)</span>
<a name="ln-1206"></a>            <span class="n">G_keyword_single_letter</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>         <span class="c">! flag this is a long keyword</span>
<a name="ln-1207"></a>         <span class="k">else</span>
<a name="ln-1208"></a><span class="k">            </span><span class="n">G_keyword_single_letter</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.</span>          <span class="c">! flag this is a short (single letter) keyword</span>
<a name="ln-1209"></a>         <span class="k">endif</span>
<a name="ln-1210"></a><span class="k">         if</span><span class="p">(</span><span class="n">ipnt</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="o">-</span><span class="mi">1</span> <span class="o">&gt;=</span> <span class="mi">1</span><span class="p">)</span><span class="k">then</span>                     <span class="c">! position in value</span>
<a name="ln-1211"></a>            <span class="n">ibegin</span><span class="o">=</span><span class="mi">1</span>
<a name="ln-1212"></a>            <span class="n">iend</span><span class="o">=</span><span class="nb">len_trim</span><span class="p">(</span><span class="k">value</span><span class="p">(:</span><span class="n">ipnt</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="o">-</span><span class="mi">1</span><span class="p">))</span>
<a name="ln-1213"></a>            <span class="n">TESTIT</span><span class="p">:</span> <span class="k">do</span>
<a name="ln-1214"></a><span class="k">               if</span><span class="p">(</span><span class="n">iend</span>  <span class="o">==</span>  <span class="mi">0</span><span class="p">)</span><span class="k">then</span>                  <span class="c">! len_trim returned 0, value is blank</span>
<a name="ln-1215"></a>                  <span class="n">iend</span><span class="o">=</span><span class="n">ibegin</span>
<a name="ln-1216"></a>                  <span class="k">exit </span><span class="n">TESTIT</span>
<a name="ln-1217"></a>               <span class="n">elseif</span><span class="p">(</span><span class="k">value</span><span class="p">(</span><span class="n">ibegin</span><span class="p">:</span><span class="n">ibegin</span><span class="p">)</span> <span class="o">==</span> <span class="s2">&quot; &quot;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1218"></a><span class="k">                  </span><span class="n">ibegin</span><span class="o">=</span><span class="n">ibegin</span><span class="o">+</span><span class="mi">1</span>
<a name="ln-1219"></a>               <span class="k">else</span>
<a name="ln-1220"></a><span class="k">                  exit </span><span class="n">TESTIT</span>
<a name="ln-1221"></a>               <span class="k">endif</span>
<a name="ln-1222"></a><span class="k">            enddo </span><span class="n">TESTIT</span>
<a name="ln-1223"></a>            <span class="k">if</span><span class="p">(</span><span class="n">keyword</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39; &#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1224"></a><span class="k">               call </span><span class="n">update</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="k">value</span><span class="p">)</span>            <span class="c">! store name and its value</span>
<a name="ln-1225"></a>            <span class="n">elseif</span><span class="p">(</span> <span class="n">G_remaining_option_allowed</span><span class="p">)</span><span class="k">then</span>  <span class="c">! meaning &quot;--&quot; has been encountered</span>
<a name="ln-1226"></a>               <span class="k">call </span><span class="n">update</span><span class="p">(</span><span class="s1">&#39;_args_&#39;</span><span class="p">,</span><span class="nb">trim</span><span class="p">(</span><span class="k">value</span><span class="p">))</span>
<a name="ln-1227"></a>            <span class="k">else</span>
<a name="ln-1228"></a>               <span class="c">!x!write(warn,&#39;(*(g0))&#39;)&#39;*prototype_to_dictionary* warning: ignoring string [&#39;,trim(value),&#39;] for &#39;,trim(keyword)</span>
<a name="ln-1229"></a>               <span class="n">G_RESPONSE_IGNORED</span><span class="o">=</span><span class="nb">TRIM</span><span class="p">(</span><span class="k">VALUE</span><span class="p">)</span>
<a name="ln-1230"></a>               <span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;PROTOTYPE_TO_DICTIONARY:G_RESPONSE_IGNORED:&#39;</span><span class="p">,</span><span class="n">G_RESPONSE_IGNORED</span>
<a name="ln-1231"></a>            <span class="k">endif</span>
<a name="ln-1232"></a><span class="k">         else</span>
<a name="ln-1233"></a><span class="k">            call </span><span class="n">locate_key</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-1234"></a>            <span class="k">if</span><span class="p">(</span><span class="n">keyword</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39; &#39;</span><span class="p">.</span><span class="nb">and</span><span class="p">.</span><span class="n">place</span><span class="p">.</span><span class="n">lt</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1235"></a><span class="k">               call </span><span class="n">update</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="s1">&#39;F&#39;</span><span class="p">)</span>           <span class="c">! store name and null value (first pass)</span>
<a name="ln-1236"></a>            <span class="n">elseif</span><span class="p">(</span><span class="n">keyword</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39; &#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1237"></a><span class="k">               call </span><span class="n">update</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="s1">&#39; &#39;</span><span class="p">)</span>           <span class="c">! store name and null value (second pass)</span>
<a name="ln-1238"></a>            <span class="n">elseif</span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="n">G_keyword_single_letter</span><span class="p">.</span><span class="nb">and</span><span class="p">.</span><span class="n">ipoint</span><span class="o">-</span><span class="mf">2.</span><span class="n">eq</span><span class="p">.</span><span class="n">islen</span><span class="p">)</span> <span class="k">then</span> <span class="c">! -- at end of line</span>
<a name="ln-1239"></a>               <span class="n">G_remaining_option_allowed</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.</span>  <span class="c">! meaning for &quot;--&quot; is that everything on commandline goes into G_remaining</span>
<a name="ln-1240"></a>            <span class="k">endif</span>
<a name="ln-1241"></a><span class="k">         endif</span>
<a name="ln-1242"></a><span class="k">         </span><span class="n">itype</span><span class="o">=</span><span class="n">KEYW</span>                            <span class="c">! change to expecting a keyword</span>
<a name="ln-1243"></a>         <span class="k">value</span><span class="o">=</span><span class="s2">&quot;&quot;</span>                              <span class="c">! clear value for this variable</span>
<a name="ln-1244"></a>         <span class="n">keyword</span><span class="o">=</span><span class="s2">&quot;&quot;</span>                            <span class="c">! clear variable name</span>
<a name="ln-1245"></a>         <span class="n">ipnt</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="o">=</span><span class="mi">1</span>                             <span class="c">! restart variable value</span>
<a name="ln-1246"></a>         <span class="n">ipnt</span><span class="p">(</span><span class="mi">2</span><span class="p">)</span><span class="o">=</span><span class="mi">1</span>                             <span class="c">! restart variable name</span>
<a name="ln-1247"></a>
<a name="ln-1248"></a>      <span class="k">else</span>       <span class="c">! currnt is not one of the special characters</span>
<a name="ln-1249"></a>         <span class="c">! the space after a keyword before the value</span>
<a name="ln-1250"></a>         <span class="k">if</span><span class="p">(</span><span class="n">currnt</span> <span class="o">==</span> <span class="s2">&quot; &quot;</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="n">itype</span>  <span class="o">==</span>  <span class="n">KEYW</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1251"></a>            <span class="c">! switch from building a keyword string to building a value string</span>
<a name="ln-1252"></a>            <span class="n">itype</span><span class="o">=</span><span class="n">VAL</span>
<a name="ln-1253"></a>            <span class="c">! beginning of a delimited value</span>
<a name="ln-1254"></a>         <span class="n">elseif</span><span class="p">(</span><span class="n">currnt</span>  <span class="o">==</span>  <span class="s2">&quot;&quot;&quot;&quot;</span><span class="p">.</span><span class="nb">and</span><span class="p">.</span><span class="n">itype</span>  <span class="o">==</span>  <span class="n">VAL</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1255"></a>            <span class="c">! second of a double quote, put quote in</span>
<a name="ln-1256"></a>            <span class="k">if</span><span class="p">(</span><span class="n">prev</span>  <span class="o">==</span>  <span class="s2">&quot;&quot;&quot;&quot;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1257"></a><span class="k">               if</span><span class="p">(</span><span class="n">itype</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="n">VAL</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1258"></a><span class="k">                  value</span><span class="o">=</span><span class="k">value</span><span class="o">//</span><span class="n">currnt</span>
<a name="ln-1259"></a>               <span class="k">else</span>
<a name="ln-1260"></a><span class="k">                  </span><span class="n">keyword</span><span class="o">=</span><span class="n">keyword</span><span class="o">//</span><span class="n">currnt</span>
<a name="ln-1261"></a>               <span class="k">endif</span>
<a name="ln-1262"></a><span class="k">               </span><span class="n">ipnt</span><span class="p">(</span><span class="n">itype</span><span class="p">)</span><span class="o">=</span><span class="n">ipnt</span><span class="p">(</span><span class="n">itype</span><span class="p">)</span><span class="o">+</span><span class="mi">1</span>
<a name="ln-1263"></a>               <span class="n">delmt</span><span class="o">=</span><span class="s2">&quot;on&quot;</span>
<a name="ln-1264"></a>            <span class="n">elseif</span><span class="p">(</span><span class="n">delmt</span>  <span class="o">==</span>  <span class="s2">&quot;on&quot;</span><span class="p">)</span><span class="k">then</span>     <span class="c">! first quote of a delimited string</span>
<a name="ln-1265"></a>               <span class="n">delmt</span><span class="o">=</span><span class="s2">&quot;off&quot;</span>
<a name="ln-1266"></a>            <span class="k">else</span>
<a name="ln-1267"></a><span class="k">               </span><span class="n">delmt</span><span class="o">=</span><span class="s2">&quot;on&quot;</span>
<a name="ln-1268"></a>            <span class="k">endif</span>
<a name="ln-1269"></a><span class="k">            if</span><span class="p">(</span><span class="n">prev</span> <span class="o">/=</span> <span class="s2">&quot;&quot;&quot;&quot;</span><span class="p">)</span><span class="k">then</span>  <span class="c">! leave quotes where found them</span>
<a name="ln-1270"></a>               <span class="k">if</span><span class="p">(</span><span class="n">itype</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="n">VAL</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1271"></a><span class="k">                  value</span><span class="o">=</span><span class="k">value</span><span class="o">//</span><span class="n">currnt</span>
<a name="ln-1272"></a>               <span class="k">else</span>
<a name="ln-1273"></a><span class="k">                  </span><span class="n">keyword</span><span class="o">=</span><span class="n">keyword</span><span class="o">//</span><span class="n">currnt</span>
<a name="ln-1274"></a>               <span class="k">endif</span>
<a name="ln-1275"></a><span class="k">               </span><span class="n">ipnt</span><span class="p">(</span><span class="n">itype</span><span class="p">)</span><span class="o">=</span><span class="n">ipnt</span><span class="p">(</span><span class="n">itype</span><span class="p">)</span><span class="o">+</span><span class="mi">1</span>
<a name="ln-1276"></a>            <span class="k">endif</span>
<a name="ln-1277"></a><span class="k">         else</span>     <span class="c">! add character to current keyword or value</span>
<a name="ln-1278"></a>            <span class="k">if</span><span class="p">(</span><span class="n">itype</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="n">VAL</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1279"></a><span class="k">               value</span><span class="o">=</span><span class="k">value</span><span class="o">//</span><span class="n">currnt</span>
<a name="ln-1280"></a>            <span class="k">else</span>
<a name="ln-1281"></a><span class="k">               </span><span class="n">keyword</span><span class="o">=</span><span class="n">keyword</span><span class="o">//</span><span class="n">currnt</span>
<a name="ln-1282"></a>            <span class="k">endif</span>
<a name="ln-1283"></a><span class="k">            </span><span class="n">ipnt</span><span class="p">(</span><span class="n">itype</span><span class="p">)</span><span class="o">=</span><span class="n">ipnt</span><span class="p">(</span><span class="n">itype</span><span class="p">)</span><span class="o">+</span><span class="mi">1</span>
<a name="ln-1284"></a>         <span class="k">endif</span>
<a name="ln-1285"></a>
<a name="ln-1286"></a><span class="k">      endif</span>
<a name="ln-1287"></a>
<a name="ln-1288"></a><span class="k">      </span><span class="n">prev</span><span class="o">=</span><span class="n">currnt</span>
<a name="ln-1289"></a>      <span class="k">if</span><span class="p">(</span><span class="n">ipoint</span> <span class="o">&lt;=</span> <span class="n">islen</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1290"></a><span class="k">         cycle</span>
<a name="ln-1291"></a><span class="k">      else</span>
<a name="ln-1292"></a><span class="k">         exit</span>
<a name="ln-1293"></a><span class="k">      endif</span>
<a name="ln-1294"></a><span class="k">   enddo</span>
<a name="ln-1295"></a>
<a name="ln-1296"></a><span class="k">end subroutine </span><span class="n">prototype_to_dictionary</span>
<a name="ln-1297"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1298"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()=</span>
<a name="ln-1299"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1300"></a><span class="c">!&gt;</span>
<a name="ln-1301"></a><span class="c">!!##NAME</span>
<a name="ln-1302"></a><span class="c">!!    specified(3f) - [ARGUMENTS:M_CLI2] return true if keyword was present</span>
<a name="ln-1303"></a><span class="c">!!    on command line</span>
<a name="ln-1304"></a><span class="c">!!    (LICENSE:PD)</span>
<a name="ln-1305"></a><span class="c">!!</span>
<a name="ln-1306"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-1307"></a><span class="c">!!</span>
<a name="ln-1308"></a><span class="c">!!    elemental impure function specified(name)</span>
<a name="ln-1309"></a><span class="c">!!</span>
<a name="ln-1310"></a><span class="c">!!     character(len=*),intent(in) :: name</span>
<a name="ln-1311"></a><span class="c">!!     logical :: specified</span>
<a name="ln-1312"></a><span class="c">!!</span>
<a name="ln-1313"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-1314"></a><span class="c">!!</span>
<a name="ln-1315"></a><span class="c">!!    specified(3f) returns .true. if the specified keyword was present on</span>
<a name="ln-1316"></a><span class="c">!!    the command line.</span>
<a name="ln-1317"></a><span class="c">!!</span>
<a name="ln-1318"></a><span class="c">!!##OPTIONS</span>
<a name="ln-1319"></a><span class="c">!!</span>
<a name="ln-1320"></a><span class="c">!!    NAME   name of commandline argument to query the presence of</span>
<a name="ln-1321"></a><span class="c">!!</span>
<a name="ln-1322"></a><span class="c">!!##RETURNS</span>
<a name="ln-1323"></a><span class="c">!!    SPECIFIED  returns .TRUE. if specified NAME was present on the command</span>
<a name="ln-1324"></a><span class="c">!!               line when the program was invoked.</span>
<a name="ln-1325"></a><span class="c">!!</span>
<a name="ln-1326"></a><span class="c">!!##EXAMPLE</span>
<a name="ln-1327"></a><span class="c">!!</span>
<a name="ln-1328"></a><span class="c">!! Sample program:</span>
<a name="ln-1329"></a><span class="c">!!</span>
<a name="ln-1330"></a><span class="c">!!    program demo_specified</span>
<a name="ln-1331"></a><span class="c">!!    use M_CLI2,  only : set_args, get_args, specified</span>
<a name="ln-1332"></a><span class="c">!!    implicit none</span>
<a name="ln-1333"></a><span class="c">!!    ! DEFINE ARGS</span>
<a name="ln-1334"></a><span class="c">!!    integer                 :: flag</span>
<a name="ln-1335"></a><span class="c">!!    integer,allocatable     :: ints(:)</span>
<a name="ln-1336"></a><span class="c">!!    real,allocatable        :: twonames(:)</span>
<a name="ln-1337"></a><span class="c">!!</span>
<a name="ln-1338"></a><span class="c">!!    ! IT IS A BAD IDEA TO NOT HAVE THE SAME DEFAULT VALUE FOR ALIASED</span>
<a name="ln-1339"></a><span class="c">!!    ! NAMES BUT CURRENTLY YOU STILL SPECIFY THEM</span>
<a name="ln-1340"></a><span class="c">!!     call set_args(&#39;-flag 1 -f 1 -ints 1,2,3 -i 1,2,3 -twonames 11.3 -T 11.3&#39;)</span>
<a name="ln-1341"></a><span class="c">!!</span>
<a name="ln-1342"></a><span class="c">!!    ! ASSIGN VALUES TO ELEMENTS CONDITIONALLY CALLING WITH SHORT NAME</span>
<a name="ln-1343"></a><span class="c">!!     call get_args(&#39;flag&#39;,flag)</span>
<a name="ln-1344"></a><span class="c">!!     if(specified(&#39;f&#39;))call get_args(&#39;f&#39;,flag)</span>
<a name="ln-1345"></a><span class="c">!!     call get_args(&#39;ints&#39;,ints)</span>
<a name="ln-1346"></a><span class="c">!!     if(specified(&#39;i&#39;))call get_args(&#39;i&#39;,ints)</span>
<a name="ln-1347"></a><span class="c">!!     call get_args(&#39;twonames&#39;,twonames)</span>
<a name="ln-1348"></a><span class="c">!!     if(specified(&#39;T&#39;))call get_args(&#39;T&#39;,twonames)</span>
<a name="ln-1349"></a><span class="c">!!</span>
<a name="ln-1350"></a><span class="c">!!     ! IF YOU WANT TO KNOW IF GROUPS OF PARAMETERS WERE SPECIFIED USE</span>
<a name="ln-1351"></a><span class="c">!!     ! ANY(3f) and ALL(3f)</span>
<a name="ln-1352"></a><span class="c">!!     write(*,*)specified([&#39;twonames&#39;,&#39;T       &#39;])</span>
<a name="ln-1353"></a><span class="c">!!     write(*,*)&#39;ANY:&#39;,any(specified([&#39;twonames&#39;,&#39;T       &#39;]))</span>
<a name="ln-1354"></a><span class="c">!!     write(*,*)&#39;ALL:&#39;,all(specified([&#39;twonames&#39;,&#39;T       &#39;]))</span>
<a name="ln-1355"></a><span class="c">!!</span>
<a name="ln-1356"></a><span class="c">!!     ! FOR MUTUALLY EXCLUSIVE</span>
<a name="ln-1357"></a><span class="c">!!     if (all(specified([&#39;twonames&#39;,&#39;T       &#39;])))then</span>
<a name="ln-1358"></a><span class="c">!!         write(*,*)&#39;You specified both names -T and -twonames&#39;</span>
<a name="ln-1359"></a><span class="c">!!     endif</span>
<a name="ln-1360"></a><span class="c">!!</span>
<a name="ln-1361"></a><span class="c">!!     ! FOR REQUIRED PARAMETER</span>
<a name="ln-1362"></a><span class="c">!!     if (.not.any(specified([&#39;twonames&#39;,&#39;T       &#39;])))then</span>
<a name="ln-1363"></a><span class="c">!!         write(*,*)&#39;You must specify -T or -twonames&#39;</span>
<a name="ln-1364"></a><span class="c">!!     endif</span>
<a name="ln-1365"></a><span class="c">!!     ! USE VALUES</span>
<a name="ln-1366"></a><span class="c">!!       write(*,*)&#39;flag=&#39;,flag</span>
<a name="ln-1367"></a><span class="c">!!       write(*,*)&#39;ints=&#39;,ints</span>
<a name="ln-1368"></a><span class="c">!!       write(*,*)&#39;twonames=&#39;,twonames</span>
<a name="ln-1369"></a><span class="c">!!     end program demo_specified</span>
<a name="ln-1370"></a><span class="c">!!</span>
<a name="ln-1371"></a><span class="c">!!##AUTHOR</span>
<a name="ln-1372"></a><span class="c">!!      John S. Urban, 2019</span>
<a name="ln-1373"></a><span class="c">!!##LICENSE</span>
<a name="ln-1374"></a><span class="c">!!      Public Domain</span>
<a name="ln-1375"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1376"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1377"></a><span class="k">elemental impure function </span><span class="n">specified</span><span class="p">(</span><span class="n">key</span><span class="p">)</span>
<a name="ln-1378"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">key</span>
<a name="ln-1379"></a><span class="kt">logical</span>                     <span class="kd">::</span> <span class="n">specified</span>
<a name="ln-1380"></a><span class="kt">integer</span>                     <span class="kd">::</span> <span class="n">place</span>
<a name="ln-1381"></a>   <span class="k">call </span><span class="n">locate_key</span><span class="p">(</span><span class="n">key</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>                   <span class="c">! find where string is or should be</span>
<a name="ln-1382"></a>   <span class="k">if</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">lt</span><span class="p">.</span><span class="mi">1</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1383"></a><span class="k">      </span><span class="n">specified</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>
<a name="ln-1384"></a>   <span class="k">else</span>
<a name="ln-1385"></a><span class="k">      </span><span class="n">specified</span><span class="o">=</span><span class="n">present_in</span><span class="p">(</span><span class="n">place</span><span class="p">)</span>
<a name="ln-1386"></a>   <span class="k">endif</span>
<a name="ln-1387"></a><span class="k">end function </span><span class="n">specified</span>
<a name="ln-1388"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1389"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()=</span>
<a name="ln-1390"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1391"></a><span class="c">!&gt;</span>
<a name="ln-1392"></a><span class="c">!!##NAME</span>
<a name="ln-1393"></a><span class="c">!!      update(3f) - [ARGUMENTS:M_CLI2] update internal dictionary given</span>
<a name="ln-1394"></a><span class="c">!!      keyword and value</span>
<a name="ln-1395"></a><span class="c">!!      (LICENSE:PD)</span>
<a name="ln-1396"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-1397"></a><span class="c">!!</span>
<a name="ln-1398"></a><span class="c">!!     subroutine update(key,val)</span>
<a name="ln-1399"></a><span class="c">!!</span>
<a name="ln-1400"></a><span class="c">!!      character(len=*),intent(in)           :: key</span>
<a name="ln-1401"></a><span class="c">!!      character(len=*),intent(in),optional  :: val</span>
<a name="ln-1402"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-1403"></a><span class="c">!!      Update internal dictionary in M_CLI2(3fm) module.</span>
<a name="ln-1404"></a><span class="c">!!##OPTIONS</span>
<a name="ln-1405"></a><span class="c">!!      key  name of keyword to add, replace, or delete from dictionary</span>
<a name="ln-1406"></a><span class="c">!!      val  if present add or replace value associated with keyword. If not</span>
<a name="ln-1407"></a><span class="c">!!           present remove keyword entry from dictionary.</span>
<a name="ln-1408"></a><span class="c">!!</span>
<a name="ln-1409"></a><span class="c">!!           If &quot;present&quot; is true, a value will be appended</span>
<a name="ln-1410"></a><span class="c">!!##EXAMPLE</span>
<a name="ln-1411"></a><span class="c">!!</span>
<a name="ln-1412"></a><span class="c">!!</span>
<a name="ln-1413"></a><span class="c">!!##AUTHOR</span>
<a name="ln-1414"></a><span class="c">!!      John S. Urban, 2019</span>
<a name="ln-1415"></a><span class="c">!!##LICENSE</span>
<a name="ln-1416"></a><span class="c">!!      Public Domain</span>
<a name="ln-1417"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1418"></a><span class="k">subroutine </span><span class="n">update</span><span class="p">(</span><span class="n">key</span><span class="p">,</span><span class="n">val</span><span class="p">)</span>
<a name="ln-1419"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>           <span class="kd">::</span> <span class="n">key</span>
<a name="ln-1420"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>  <span class="kd">::</span> <span class="n">val</span>
<a name="ln-1421"></a><span class="kt">integer</span>                               <span class="kd">::</span> <span class="n">place</span><span class="p">,</span> <span class="n">ii</span>
<a name="ln-1422"></a><span class="kt">integer</span>                               <span class="kd">::</span> <span class="n">iilen</span>
<a name="ln-1423"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>          <span class="kd">::</span> <span class="n">val_local</span>
<a name="ln-1424"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>          <span class="kd">::</span> <span class="nb">short</span>
<a name="ln-1425"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>          <span class="kd">::</span> <span class="nb">long</span>
<a name="ln-1426"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>          <span class="kd">::</span> <span class="n">long_short</span><span class="p">(:)</span>
<a name="ln-1427"></a><span class="kt">integer</span>                               <span class="kd">::</span> <span class="n">isize</span>
<a name="ln-1428"></a><span class="kt">logical</span>                               <span class="kd">::</span> <span class="n">set_mandatory</span>
<a name="ln-1429"></a>   <span class="n">set_mandatory</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>
<a name="ln-1430"></a>   <span class="k">call </span><span class="n">split</span><span class="p">(</span><span class="nb">trim</span><span class="p">(</span><span class="n">key</span><span class="p">),</span><span class="n">long_short</span><span class="p">,</span><span class="s1">&#39;:&#39;</span><span class="p">,</span><span class="n">nulls</span><span class="o">=</span><span class="s1">&#39;return&#39;</span><span class="p">)</span> <span class="c">! split long:short keyname or long:short:: or long:: or short::</span>
<a name="ln-1431"></a>   <span class="c">! check for :: on end</span>
<a name="ln-1432"></a>   <span class="n">isize</span><span class="o">=</span><span class="n">size</span><span class="p">(</span><span class="n">long_short</span><span class="p">)</span>
<a name="ln-1433"></a>
<a name="ln-1434"></a>   <span class="k">if</span><span class="p">(</span><span class="n">isize</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>                     <span class="c">! very special-purpose syntax where if ends in :: next field is a value even</span>
<a name="ln-1435"></a>      <span class="k">if</span><span class="p">(</span><span class="n">long_short</span><span class="p">(</span><span class="n">isize</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="s1">&#39;&#39;</span><span class="p">)</span><span class="k">then</span>     <span class="c">! if it starts with a dash, for --flags option on fpm(1).</span>
<a name="ln-1436"></a>         <span class="n">set_mandatory</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.</span>
<a name="ln-1437"></a>         <span class="n">long_short</span><span class="o">=</span><span class="n">long_short</span><span class="p">(:</span><span class="n">isize</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span>
<a name="ln-1438"></a>      <span class="k">endif</span>
<a name="ln-1439"></a><span class="k">   endif</span>
<a name="ln-1440"></a>
<a name="ln-1441"></a><span class="k">   select case</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">long_short</span><span class="p">))</span>
<a name="ln-1442"></a>   <span class="k">case</span><span class="p">(</span><span class="mi">0</span><span class="p">)</span>
<a name="ln-1443"></a>      <span class="nb">long</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-1444"></a>      <span class="nb">short</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-1445"></a>   <span class="k">case</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span>
<a name="ln-1446"></a>      <span class="nb">long</span><span class="o">=</span><span class="nb">trim</span><span class="p">(</span><span class="n">long_short</span><span class="p">(</span><span class="mi">1</span><span class="p">))</span>
<a name="ln-1447"></a>      <span class="k">if</span><span class="p">(</span><span class="nb">len_trim</span><span class="p">(</span><span class="nb">long</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="mi">1</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1448"></a>         <span class="c">!x!ii= findloc (shorts, long, dim=1) ! if parsing arguments on line and a short keyword look up long value</span>
<a name="ln-1449"></a>         <span class="n">ii</span><span class="o">=</span><span class="nb">maxloc</span><span class="p">([</span><span class="mi">0</span><span class="p">,</span><span class="nb">merge</span><span class="p">(</span><span class="mi">1</span><span class="p">,</span> <span class="mi">0</span><span class="p">,</span> <span class="n">shorts</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="nb">long</span><span class="p">)],</span><span class="nb">dim</span><span class="o">=</span><span class="mi">1</span><span class="p">)</span>
<a name="ln-1450"></a>         <span class="k">if</span><span class="p">(</span><span class="n">ii</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="mi">1</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1451"></a><span class="k">            </span><span class="nb">long</span><span class="o">=</span><span class="n">keywords</span><span class="p">(</span><span class="n">ii</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span>
<a name="ln-1452"></a>         <span class="k">endif</span>
<a name="ln-1453"></a><span class="k">         </span><span class="nb">short</span><span class="o">=</span><span class="nb">long</span>
<a name="ln-1454"></a><span class="nb">      </span><span class="k">else</span>
<a name="ln-1455"></a><span class="k">         </span><span class="nb">short</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-1456"></a>      <span class="k">endif</span>
<a name="ln-1457"></a><span class="k">   case</span><span class="p">(</span><span class="mi">2</span><span class="p">)</span>
<a name="ln-1458"></a>      <span class="n">G_STRICT</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.</span>  <span class="c">! strict short and long rules so do not allow -longname and --shortname</span>
<a name="ln-1459"></a>      <span class="nb">long</span><span class="o">=</span><span class="nb">trim</span><span class="p">(</span><span class="n">long_short</span><span class="p">(</span><span class="mi">1</span><span class="p">))</span>
<a name="ln-1460"></a>      <span class="nb">short</span><span class="o">=</span><span class="nb">trim</span><span class="p">(</span><span class="n">long_short</span><span class="p">(</span><span class="mi">2</span><span class="p">))</span>
<a name="ln-1461"></a>   <span class="k">case </span><span class="n">default</span>
<a name="ln-1462"></a>      <span class="k">write</span><span class="p">(</span><span class="n">warn</span><span class="p">,</span><span class="o">*</span><span class="p">)</span><span class="s1">&#39;WARNING: incorrect syntax for key: &#39;</span><span class="p">,</span><span class="nb">trim</span><span class="p">(</span><span class="n">key</span><span class="p">)</span>
<a name="ln-1463"></a>      <span class="nb">long</span><span class="o">=</span><span class="nb">trim</span><span class="p">(</span><span class="n">long_short</span><span class="p">(</span><span class="mi">1</span><span class="p">))</span>
<a name="ln-1464"></a>      <span class="nb">short</span><span class="o">=</span><span class="nb">trim</span><span class="p">(</span><span class="n">long_short</span><span class="p">(</span><span class="mi">2</span><span class="p">))</span>
<a name="ln-1465"></a>   <span class="k">end select</span>
<a name="ln-1466"></a>
<a name="ln-1467"></a><span class="k">   if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">val</span><span class="p">))</span><span class="k">then</span>
<a name="ln-1468"></a><span class="k">      </span><span class="n">val_local</span><span class="o">=</span><span class="n">val</span>
<a name="ln-1469"></a>      <span class="n">iilen</span><span class="o">=</span><span class="nb">len_trim</span><span class="p">(</span><span class="n">val_local</span><span class="p">)</span>
<a name="ln-1470"></a>      <span class="k">call </span><span class="n">locate_key</span><span class="p">(</span><span class="nb">long</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>                  <span class="c">! find where string is or should be</span>
<a name="ln-1471"></a>      <span class="k">if</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">lt</span><span class="p">.</span><span class="mi">1</span><span class="p">)</span><span class="k">then</span>                                <span class="c">! if string was not found insert it</span>
<a name="ln-1472"></a>         <span class="k">call </span><span class="n">insert</span><span class="p">(</span><span class="n">keywords</span><span class="p">,</span><span class="nb">long</span><span class="p">,</span><span class="nb">iabs</span><span class="p">(</span><span class="n">place</span><span class="p">))</span>
<a name="ln-1473"></a>         <span class="k">call </span><span class="n">insert</span><span class="p">(</span><span class="n">values</span><span class="p">,</span><span class="n">val_local</span><span class="p">,</span><span class="nb">iabs</span><span class="p">(</span><span class="n">place</span><span class="p">))</span>
<a name="ln-1474"></a>         <span class="k">call </span><span class="n">insert</span><span class="p">(</span><span class="n">counts</span><span class="p">,</span><span class="n">iilen</span><span class="p">,</span><span class="nb">iabs</span><span class="p">(</span><span class="n">place</span><span class="p">))</span>
<a name="ln-1475"></a>         <span class="k">call </span><span class="n">insert</span><span class="p">(</span><span class="n">shorts</span><span class="p">,</span><span class="nb">short</span><span class="p">,</span><span class="nb">iabs</span><span class="p">(</span><span class="n">place</span><span class="p">))</span>
<a name="ln-1476"></a>         <span class="k">call </span><span class="n">insert</span><span class="p">(</span><span class="n">present_in</span><span class="p">,.</span><span class="n">true</span><span class="p">.,</span><span class="nb">iabs</span><span class="p">(</span><span class="n">place</span><span class="p">))</span>
<a name="ln-1477"></a>         <span class="k">call </span><span class="n">insert</span><span class="p">(</span><span class="n">mandatory</span><span class="p">,</span><span class="n">set_mandatory</span><span class="p">,</span><span class="nb">iabs</span><span class="p">(</span><span class="n">place</span><span class="p">))</span>
<a name="ln-1478"></a>      <span class="k">else</span>
<a name="ln-1479"></a><span class="k">         if</span><span class="p">(</span><span class="n">present_in</span><span class="p">(</span><span class="n">place</span><span class="p">))</span><span class="k">then</span>                      <span class="c">! if multiple keywords append values with space between them</span>
<a name="ln-1480"></a>            <span class="k">if</span><span class="p">(</span><span class="n">G_append</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1481"></a><span class="k">               if</span><span class="p">(</span><span class="n">values</span><span class="p">(</span><span class="n">place</span><span class="p">)(</span><span class="mi">1</span><span class="p">:</span><span class="mi">1</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="s1">&#39;&quot;&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1482"></a>               <span class="c">! UNDESIRABLE: will ignore previous blank entries</span>
<a name="ln-1483"></a>                  <span class="n">val_local</span><span class="o">=</span><span class="s1">&#39;&quot;&#39;</span><span class="o">//</span><span class="nb">trim</span><span class="p">(</span><span class="n">unquote</span><span class="p">(</span><span class="n">values</span><span class="p">(</span><span class="n">place</span><span class="p">)))</span><span class="o">//</span><span class="s1">&#39; &#39;</span><span class="o">//</span><span class="nb">trim</span><span class="p">(</span><span class="n">unquote</span><span class="p">(</span><span class="n">val_local</span><span class="p">))</span><span class="o">//</span><span class="s1">&#39;&quot;&#39;</span>
<a name="ln-1484"></a>               <span class="k">else</span>
<a name="ln-1485"></a><span class="k">                  </span><span class="n">val_local</span><span class="o">=</span><span class="n">values</span><span class="p">(</span><span class="n">place</span><span class="p">)</span><span class="o">//</span><span class="s1">&#39; &#39;</span><span class="o">//</span><span class="n">val_local</span>
<a name="ln-1486"></a>               <span class="k">endif</span>
<a name="ln-1487"></a><span class="k">            endif</span>
<a name="ln-1488"></a><span class="k">            </span><span class="n">iilen</span><span class="o">=</span><span class="nb">len_trim</span><span class="p">(</span><span class="n">val_local</span><span class="p">)</span>
<a name="ln-1489"></a>         <span class="k">endif</span>
<a name="ln-1490"></a><span class="k">         call </span><span class="n">replace</span><span class="p">(</span><span class="n">values</span><span class="p">,</span><span class="n">val_local</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-1491"></a>         <span class="k">call </span><span class="n">replace</span><span class="p">(</span><span class="n">counts</span><span class="p">,</span><span class="n">iilen</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-1492"></a>         <span class="k">call </span><span class="n">replace</span><span class="p">(</span><span class="n">present_in</span><span class="p">,.</span><span class="n">true</span><span class="p">.,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-1493"></a>      <span class="k">endif</span>
<a name="ln-1494"></a><span class="k">   else</span>                                                 <span class="c">! if no value is present remove the keyword and related values</span>
<a name="ln-1495"></a>      <span class="k">call </span><span class="n">locate_key</span><span class="p">(</span><span class="nb">long</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>                       <span class="c">! check name as long and short</span>
<a name="ln-1496"></a>      <span class="k">if</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1497"></a><span class="k">         call </span><span class="n">remove</span><span class="p">(</span><span class="n">keywords</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-1498"></a>         <span class="k">call </span><span class="n">remove</span><span class="p">(</span><span class="n">values</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-1499"></a>         <span class="k">call </span><span class="n">remove</span><span class="p">(</span><span class="n">counts</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-1500"></a>         <span class="k">call </span><span class="n">remove</span><span class="p">(</span><span class="n">shorts</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-1501"></a>         <span class="k">call </span><span class="n">remove</span><span class="p">(</span><span class="n">present_in</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-1502"></a>         <span class="k">call </span><span class="n">remove</span><span class="p">(</span><span class="n">mandatory</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-1503"></a>      <span class="k">endif</span>
<a name="ln-1504"></a><span class="k">   endif</span>
<a name="ln-1505"></a><span class="k">end subroutine </span><span class="n">update</span>
<a name="ln-1506"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1507"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-1508"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1509"></a><span class="c">!&gt;</span>
<a name="ln-1510"></a><span class="c">!!##NAME</span>
<a name="ln-1511"></a><span class="c">!!      wipe_dictionary(3fp) - [ARGUMENTS:M_CLI2] reset private M_CLI2(3fm)</span>
<a name="ln-1512"></a><span class="c">!!      dictionary to empty</span>
<a name="ln-1513"></a><span class="c">!!      (LICENSE:PD)</span>
<a name="ln-1514"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-1515"></a><span class="c">!!</span>
<a name="ln-1516"></a><span class="c">!!      subroutine wipe_dictionary()</span>
<a name="ln-1517"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-1518"></a><span class="c">!!      reset private M_CLI2(3fm) dictionary to empty</span>
<a name="ln-1519"></a><span class="c">!!##EXAMPLE</span>
<a name="ln-1520"></a><span class="c">!!</span>
<a name="ln-1521"></a><span class="c">!! Sample program:</span>
<a name="ln-1522"></a><span class="c">!!</span>
<a name="ln-1523"></a><span class="c">!!      program demo_wipe_dictionary</span>
<a name="ln-1524"></a><span class="c">!!      use M_CLI2, only : dictionary</span>
<a name="ln-1525"></a><span class="c">!!         call wipe_dictionary()</span>
<a name="ln-1526"></a><span class="c">!!      end program demo_wipe_dictionary</span>
<a name="ln-1527"></a><span class="c">!!##AUTHOR</span>
<a name="ln-1528"></a><span class="c">!!      John S. Urban, 2019</span>
<a name="ln-1529"></a><span class="c">!!##LICENSE</span>
<a name="ln-1530"></a><span class="c">!!      Public Domain</span>
<a name="ln-1531"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1532"></a><span class="k">subroutine </span><span class="n">wipe_dictionary</span><span class="p">()</span>
<a name="ln-1533"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">keywords</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">keywords</span><span class="p">)</span>
<a name="ln-1534"></a>   <span class="k">allocate</span><span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">0</span><span class="p">)</span> <span class="kd">::</span> <span class="n">keywords</span><span class="p">(</span><span class="mi">0</span><span class="p">))</span>
<a name="ln-1535"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">values</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">values</span><span class="p">)</span>
<a name="ln-1536"></a>   <span class="k">allocate</span><span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">0</span><span class="p">)</span> <span class="kd">::</span> <span class="n">values</span><span class="p">(</span><span class="mi">0</span><span class="p">))</span>
<a name="ln-1537"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">counts</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">counts</span><span class="p">)</span>
<a name="ln-1538"></a>   <span class="k">allocate</span><span class="p">(</span><span class="n">counts</span><span class="p">(</span><span class="mi">0</span><span class="p">))</span>
<a name="ln-1539"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">shorts</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">shorts</span><span class="p">)</span>
<a name="ln-1540"></a>   <span class="k">allocate</span><span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">0</span><span class="p">)</span> <span class="kd">::</span> <span class="n">shorts</span><span class="p">(</span><span class="mi">0</span><span class="p">))</span>
<a name="ln-1541"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">present_in</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">present_in</span><span class="p">)</span>
<a name="ln-1542"></a>   <span class="k">allocate</span><span class="p">(</span><span class="n">present_in</span><span class="p">(</span><span class="mi">0</span><span class="p">))</span>
<a name="ln-1543"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">mandatory</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">mandatory</span><span class="p">)</span>
<a name="ln-1544"></a>   <span class="k">allocate</span><span class="p">(</span><span class="n">mandatory</span><span class="p">(</span><span class="mi">0</span><span class="p">))</span>
<a name="ln-1545"></a><span class="k">end subroutine </span><span class="n">wipe_dictionary</span>
<a name="ln-1546"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1547"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-1548"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1549"></a><span class="c">!&gt;</span>
<a name="ln-1550"></a><span class="c">!!##NAME</span>
<a name="ln-1551"></a><span class="c">!!    get(3f) - [ARGUMENTS:M_CLI2] get dictionary value associated with</span>
<a name="ln-1552"></a><span class="c">!!    key name in private M_CLI2(3fm) dictionary</span>
<a name="ln-1553"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-1554"></a><span class="c">!!</span>
<a name="ln-1555"></a><span class="c">!!</span>
<a name="ln-1556"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-1557"></a><span class="c">!!    Get dictionary value associated with key name in private M_CLI2(3fm)</span>
<a name="ln-1558"></a><span class="c">!!    dictionary.</span>
<a name="ln-1559"></a><span class="c">!!##OPTIONS</span>
<a name="ln-1560"></a><span class="c">!!##RETURNS</span>
<a name="ln-1561"></a><span class="c">!!##EXAMPLE</span>
<a name="ln-1562"></a><span class="c">!!</span>
<a name="ln-1563"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1564"></a><span class="k">function </span><span class="n">get</span><span class="p">(</span><span class="n">key</span><span class="p">)</span> <span class="k">result</span><span class="p">(</span><span class="n">valout</span><span class="p">)</span>
<a name="ln-1565"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>   <span class="kd">::</span> <span class="n">key</span>
<a name="ln-1566"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>  <span class="kd">::</span> <span class="n">valout</span>
<a name="ln-1567"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">place</span>
<a name="ln-1568"></a>   <span class="c">! find where string is or should be</span>
<a name="ln-1569"></a>   <span class="k">call </span><span class="n">locate_key</span><span class="p">(</span><span class="n">key</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-1570"></a>   <span class="k">if</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">lt</span><span class="p">.</span><span class="mi">1</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1571"></a><span class="k">      </span><span class="n">valout</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-1572"></a>   <span class="k">else</span>
<a name="ln-1573"></a><span class="k">      </span><span class="n">valout</span><span class="o">=</span><span class="n">values</span><span class="p">(</span><span class="n">place</span><span class="p">)(:</span><span class="n">counts</span><span class="p">(</span><span class="n">place</span><span class="p">))</span>
<a name="ln-1574"></a>   <span class="k">endif</span>
<a name="ln-1575"></a><span class="k">end function </span><span class="n">get</span>
<a name="ln-1576"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1577"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-1578"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1579"></a><span class="c">!&gt;</span>
<a name="ln-1580"></a><span class="c">!!##NAME</span>
<a name="ln-1581"></a><span class="c">!!      prototype_and_cmd_args_to_nlist(3f) - [ARGUMENTS:M_CLI2] convert</span>
<a name="ln-1582"></a><span class="c">!!      Unix-like command arguments to table</span>
<a name="ln-1583"></a><span class="c">!!      (LICENSE:PD)</span>
<a name="ln-1584"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-1585"></a><span class="c">!!</span>
<a name="ln-1586"></a><span class="c">!!     subroutine prototype_and_cmd_args_to_nlist(prototype)</span>
<a name="ln-1587"></a><span class="c">!!</span>
<a name="ln-1588"></a><span class="c">!!      character(len=*)             :: prototype</span>
<a name="ln-1589"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-1590"></a><span class="c">!!    create dictionary with character keywords, values, and value lengths</span>
<a name="ln-1591"></a><span class="c">!!    using the routines for maintaining a list from command line arguments.</span>
<a name="ln-1592"></a><span class="c">!!##OPTIONS</span>
<a name="ln-1593"></a><span class="c">!!      prototype</span>
<a name="ln-1594"></a><span class="c">!!##EXAMPLE</span>
<a name="ln-1595"></a><span class="c">!!</span>
<a name="ln-1596"></a><span class="c">!! Sample program</span>
<a name="ln-1597"></a><span class="c">!!</span>
<a name="ln-1598"></a><span class="c">!!      program demo_prototype_and_cmd_args_to_nlist</span>
<a name="ln-1599"></a><span class="c">!!      use M_CLI2,  only : prototype_and_cmd_args_to_nlist, unnamed</span>
<a name="ln-1600"></a><span class="c">!!      implicit none</span>
<a name="ln-1601"></a><span class="c">!!      character(len=:),allocatable :: readme</span>
<a name="ln-1602"></a><span class="c">!!      character(len=256)           :: message</span>
<a name="ln-1603"></a><span class="c">!!      integer                      :: ios</span>
<a name="ln-1604"></a><span class="c">!!      integer                      :: i</span>
<a name="ln-1605"></a><span class="c">!!      doubleprecision              :: something</span>
<a name="ln-1606"></a><span class="c">!!</span>
<a name="ln-1607"></a><span class="c">!!      ! define arguments</span>
<a name="ln-1608"></a><span class="c">!!      logical            :: l,h,v</span>
<a name="ln-1609"></a><span class="c">!!      real               :: p(2)</span>
<a name="ln-1610"></a><span class="c">!!      complex            :: c</span>
<a name="ln-1611"></a><span class="c">!!      doubleprecision    :: x,y,z</span>
<a name="ln-1612"></a><span class="c">!!</span>
<a name="ln-1613"></a><span class="c">!!      ! uppercase keywords get an underscore to make it easier o remember</span>
<a name="ln-1614"></a><span class="c">!!      logical            :: l_,h_,v_</span>
<a name="ln-1615"></a><span class="c">!!      ! character variables must be long enough to hold returned value</span>
<a name="ln-1616"></a><span class="c">!!      character(len=256) :: a_,b_</span>
<a name="ln-1617"></a><span class="c">!!      integer            :: c_(3)</span>
<a name="ln-1618"></a><span class="c">!!</span>
<a name="ln-1619"></a><span class="c">!!         ! give command template with default values</span>
<a name="ln-1620"></a><span class="c">!!         ! all values except logicals get a value.</span>
<a name="ln-1621"></a><span class="c">!!         ! strings must be delimited with double quotes</span>
<a name="ln-1622"></a><span class="c">!!         ! A string has to have at least one character as for -A</span>
<a name="ln-1623"></a><span class="c">!!         ! lists of numbers should be comma-delimited.</span>
<a name="ln-1624"></a><span class="c">!!         ! No spaces are allowed in lists of numbers</span>
<a name="ln-1625"></a><span class="c">!!         call prototype_and_cmd_args_to_nlist(&#39;&amp;</span>
<a name="ln-1626"></a><span class="c">!!         &amp; -l -v -h -LVH -x 0 -y 0.0 -z 0.0d0 -p 0,0 &amp;</span>
<a name="ln-1627"></a><span class="c">!!         &amp; -A &quot; &quot; -B &quot;Value B&quot; -C 10,20,30 -c (-123,-456)&#39;,readme)</span>
<a name="ln-1628"></a><span class="c">!!</span>
<a name="ln-1629"></a><span class="c">!!         call get_args(&#39;x&#39;,x,&#39;y&#39;,y,&#39;z&#39;,z)</span>
<a name="ln-1630"></a><span class="c">!!            something=sqrt(x**2+y**2+z**2)</span>
<a name="ln-1631"></a><span class="c">!!            write (*,*)something,x,y,z</span>
<a name="ln-1632"></a><span class="c">!!            if(size(unnamed).gt.0)then</span>
<a name="ln-1633"></a><span class="c">!!               write (*,&#39;(a)&#39;)&#39;files:&#39;</span>
<a name="ln-1634"></a><span class="c">!!               write (*,&#39;(i6.6,3a)&#39;)(i,&#39;[&#39;,unnamed(i),&#39;]&#39;,i=1,size(unnamed))</span>
<a name="ln-1635"></a><span class="c">!!            endif</span>
<a name="ln-1636"></a><span class="c">!!      end program demo_prototype_and_cmd_args_to_nlist</span>
<a name="ln-1637"></a><span class="c">!!##AUTHOR</span>
<a name="ln-1638"></a><span class="c">!!      John S. Urban, 2019</span>
<a name="ln-1639"></a><span class="c">!!##LICENSE</span>
<a name="ln-1640"></a><span class="c">!!      Public Domain</span>
<a name="ln-1641"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1642"></a><span class="k">subroutine </span><span class="n">prototype_and_cmd_args_to_nlist</span><span class="p">(</span><span class="n">prototype</span><span class="p">,</span><span class="n">string</span><span class="p">)</span>
<a name="ln-1643"></a><span class="k">implicit none</span>
<a name="ln-1644"></a>
<a name="ln-1645"></a><span class="c">! ident_5=&quot;@(#)M_CLI2::prototype_and_cmd_args_to_nlist: create dictionary from prototype if not null and update from command line&quot;</span>
<a name="ln-1646"></a>
<a name="ln-1647"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>           <span class="kd">::</span> <span class="n">prototype</span>
<a name="ln-1648"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>  <span class="kd">::</span> <span class="n">string</span>
<a name="ln-1649"></a><span class="kt">integer</span>                               <span class="kd">::</span> <span class="n">ibig</span>
<a name="ln-1650"></a><span class="kt">integer</span>                               <span class="kd">::</span> <span class="n">itrim</span>
<a name="ln-1651"></a><span class="kt">integer</span>                               <span class="kd">::</span> <span class="n">iused</span>
<a name="ln-1652"></a>
<a name="ln-1653"></a>   <span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;CMD_ARGS_TO_NLIST:START&#39;</span>
<a name="ln-1654"></a>   <span class="n">G_passed_in</span><span class="o">=</span><span class="n">prototype</span>                            <span class="c">! make global copy for printing</span>
<a name="ln-1655"></a>   <span class="n">G_STRICT</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>  <span class="c">! strict short and long rules or allow -longname and --shortname</span>
<a name="ln-1656"></a>
<a name="ln-1657"></a>   <span class="n">ibig</span><span class="o">=</span><span class="n">longest_command_argument</span><span class="p">()</span>                  <span class="c">! bug in gfortran. len=0 should be fine</span>
<a name="ln-1658"></a>   <span class="n">ibig</span><span class="o">=</span><span class="nb">max</span><span class="p">(</span><span class="n">ibig</span><span class="p">,</span><span class="mi">1</span><span class="p">)</span>
<a name="ln-1659"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">unnamed</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">unnamed</span><span class="p">)</span>
<a name="ln-1660"></a>   <span class="k">allocate</span><span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="n">ibig</span><span class="p">)</span> <span class="kd">::</span> <span class="n">unnamed</span><span class="p">(</span><span class="mi">0</span><span class="p">))</span>
<a name="ln-1661"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">args</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">args</span><span class="p">)</span>
<a name="ln-1662"></a>   <span class="k">allocate</span><span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="n">ibig</span><span class="p">)</span> <span class="kd">::</span> <span class="n">args</span><span class="p">(</span><span class="mi">0</span><span class="p">))</span>
<a name="ln-1663"></a>
<a name="ln-1664"></a>   <span class="n">G_remaining_option_allowed</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>
<a name="ln-1665"></a>   <span class="n">G_remaining_on</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>
<a name="ln-1666"></a>   <span class="n">G_remaining</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-1667"></a>   <span class="k">if</span><span class="p">(</span><span class="n">prototype</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39;&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1668"></a><span class="k">      call </span><span class="n">prototype_to_dictionary</span><span class="p">(</span><span class="n">prototype</span><span class="p">)</span>       <span class="c">! build dictionary from prototype</span>
<a name="ln-1669"></a>
<a name="ln-1670"></a>      <span class="c">! if short keywords not used by user allow them for standard options</span>
<a name="ln-1671"></a>
<a name="ln-1672"></a>      <span class="k">call </span><span class="n">locate_key</span><span class="p">(</span><span class="s1">&#39;h&#39;</span><span class="p">,</span><span class="n">iused</span><span class="p">)</span>
<a name="ln-1673"></a>      <span class="k">if</span><span class="p">(</span><span class="n">iused</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1674"></a><span class="k">         call </span><span class="n">update</span><span class="p">(</span><span class="s1">&#39;help&#39;</span><span class="p">)</span>
<a name="ln-1675"></a>         <span class="k">call </span><span class="n">update</span><span class="p">(</span><span class="s1">&#39;help:h&#39;</span><span class="p">,</span><span class="s1">&#39;F&#39;</span><span class="p">)</span>
<a name="ln-1676"></a>      <span class="k">endif</span>
<a name="ln-1677"></a>
<a name="ln-1678"></a><span class="k">      call </span><span class="n">locate_key</span><span class="p">(</span><span class="s1">&#39;v&#39;</span><span class="p">,</span><span class="n">iused</span><span class="p">)</span>
<a name="ln-1679"></a>      <span class="k">if</span><span class="p">(</span><span class="n">iused</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1680"></a><span class="k">         call </span><span class="n">update</span><span class="p">(</span><span class="s1">&#39;version&#39;</span><span class="p">)</span>
<a name="ln-1681"></a>         <span class="k">call </span><span class="n">update</span><span class="p">(</span><span class="s1">&#39;version:v&#39;</span><span class="p">,</span><span class="s1">&#39;F&#39;</span><span class="p">)</span>
<a name="ln-1682"></a>      <span class="k">endif</span>
<a name="ln-1683"></a>
<a name="ln-1684"></a><span class="k">      call </span><span class="n">locate_key</span><span class="p">(</span><span class="s1">&#39;V&#39;</span><span class="p">,</span><span class="n">iused</span><span class="p">)</span>
<a name="ln-1685"></a>      <span class="k">if</span><span class="p">(</span><span class="n">iused</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1686"></a><span class="k">         call </span><span class="n">update</span><span class="p">(</span><span class="s1">&#39;verbose&#39;</span><span class="p">)</span>
<a name="ln-1687"></a>         <span class="k">call </span><span class="n">update</span><span class="p">(</span><span class="s1">&#39;verbose:V&#39;</span><span class="p">,</span><span class="s1">&#39;F&#39;</span><span class="p">)</span>
<a name="ln-1688"></a>      <span class="k">endif</span>
<a name="ln-1689"></a>
<a name="ln-1690"></a><span class="k">      call </span><span class="n">locate_key</span><span class="p">(</span><span class="s1">&#39;u&#39;</span><span class="p">,</span><span class="n">iused</span><span class="p">)</span>
<a name="ln-1691"></a>      <span class="k">if</span><span class="p">(</span><span class="n">iused</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1692"></a><span class="k">         call </span><span class="n">update</span><span class="p">(</span><span class="s1">&#39;usage&#39;</span><span class="p">)</span>
<a name="ln-1693"></a>         <span class="k">call </span><span class="n">update</span><span class="p">(</span><span class="s1">&#39;usage:u&#39;</span><span class="p">,</span><span class="s1">&#39;F&#39;</span><span class="p">)</span>
<a name="ln-1694"></a>      <span class="k">endif</span>
<a name="ln-1695"></a>
<a name="ln-1696"></a><span class="k">      </span><span class="n">present_in</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>                            <span class="c">! reset all values to false so everything gets written</span>
<a name="ln-1697"></a>   <span class="k">endif</span>
<a name="ln-1698"></a>
<a name="ln-1699"></a><span class="k">   if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">string</span><span class="p">))</span><span class="k">then</span>                          <span class="c">! instead of command line arguments use another prototype string</span>
<a name="ln-1700"></a>      <span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;CMD_ARGS_TO_NLIST:CALL PROTOTYPE_TO_DICTIONARY:STRING=&#39;</span><span class="p">,</span><span class="n">STRING</span>
<a name="ln-1701"></a>      <span class="k">call </span><span class="n">prototype_to_dictionary</span><span class="p">(</span><span class="n">string</span><span class="p">)</span>          <span class="c">! build dictionary from prototype</span>
<a name="ln-1702"></a>   <span class="k">else</span>
<a name="ln-1703"></a><span class="k">      if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;CMD_ARGS_TO_NLIST:CALL CMD_ARGS_TO_DICTIONARY:CHECK=&#39;</span><span class="p">,.</span><span class="n">true</span><span class="p">.</span>
<a name="ln-1704"></a>      <span class="k">call </span><span class="n">cmd_args_to_dictionary</span><span class="p">()</span>
<a name="ln-1705"></a>   <span class="k">endif</span>
<a name="ln-1706"></a>
<a name="ln-1707"></a><span class="k">   if</span><span class="p">(</span><span class="nb">len</span><span class="p">(</span><span class="n">G_remaining</span><span class="p">).</span><span class="n">gt</span><span class="p">.</span><span class="mi">1</span><span class="p">)</span><span class="k">then</span>                    <span class="c">! if -- was in prototype then after -- on input return rest in this string</span>
<a name="ln-1708"></a>      <span class="n">itrim</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">G_remaining</span><span class="p">)</span>
<a name="ln-1709"></a>      <span class="k">if</span><span class="p">(</span><span class="n">G_remaining</span><span class="p">(</span><span class="n">itrim</span><span class="p">:</span><span class="n">itrim</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="s1">&#39; &#39;</span><span class="p">)</span><span class="k">then</span>       <span class="c">! was adding a space at end as building it, but do not want to remove blanks</span>
<a name="ln-1710"></a>         <span class="n">G_remaining</span><span class="o">=</span><span class="n">G_remaining</span><span class="p">(:</span><span class="n">itrim</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span>
<a name="ln-1711"></a>      <span class="k">endif</span>
<a name="ln-1712"></a><span class="k">      </span><span class="n">remaining</span><span class="o">=</span><span class="n">G_remaining</span>
<a name="ln-1713"></a>   <span class="k">endif</span>
<a name="ln-1714"></a><span class="k">   if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;CMD_ARGS_TO_NLIST:NORMAL END&#39;</span>
<a name="ln-1715"></a><span class="k">end subroutine </span><span class="n">prototype_and_cmd_args_to_nlist</span>
<a name="ln-1716"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1717"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-1718"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1719"></a><span class="k">subroutine </span><span class="n">expand_response</span><span class="p">(</span><span class="n">name</span><span class="p">)</span>
<a name="ln-1720"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">name</span>
<a name="ln-1721"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">prototype</span>
<a name="ln-1722"></a><span class="kt">logical</span> <span class="kd">::</span> <span class="n">hold</span>
<a name="ln-1723"></a>   <span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;EXPAND_RESPONSE:START:NAME=&#39;</span><span class="p">,</span><span class="n">name</span>
<a name="ln-1724"></a>   <span class="k">call </span><span class="n">get_prototype</span><span class="p">(</span><span class="n">name</span><span class="p">,</span><span class="n">prototype</span><span class="p">)</span>
<a name="ln-1725"></a>   <span class="k">if</span><span class="p">(</span><span class="n">prototype</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39;&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1726"></a><span class="k">      </span><span class="n">hold</span><span class="o">=</span><span class="n">G_append</span>
<a name="ln-1727"></a>      <span class="n">G_append</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>
<a name="ln-1728"></a>      <span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;EXPAND_RESPONSE:CALL PROTOTYPE_TO_DICTIONARY:PROTOTYPE=&#39;</span><span class="p">,</span><span class="n">prototype</span>
<a name="ln-1729"></a>      <span class="k">call </span><span class="n">prototype_to_dictionary</span><span class="p">(</span><span class="n">prototype</span><span class="p">)</span>       <span class="c">! build dictionary from prototype</span>
<a name="ln-1730"></a>      <span class="n">G_append</span><span class="o">=</span><span class="n">hold</span>
<a name="ln-1731"></a>   <span class="k">endif</span>
<a name="ln-1732"></a><span class="k">   if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;EXPAND_RESPONSE:END&#39;</span>
<a name="ln-1733"></a><span class="k">end subroutine </span><span class="n">expand_response</span>
<a name="ln-1734"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1735"></a><span class="k">subroutine </span><span class="n">get_prototype</span><span class="p">(</span><span class="n">name</span><span class="p">,</span><span class="n">prototype</span><span class="p">)</span> <span class="c">! process @name abbreviations</span>
<a name="ln-1736"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">name</span>
<a name="ln-1737"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span> <span class="kd">::</span> <span class="n">prototype</span>
<a name="ln-1738"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>             <span class="kd">::</span> <span class="n">filename</span>
<a name="ln-1739"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>             <span class="kd">::</span> <span class="n">os</span>
<a name="ln-1740"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>             <span class="kd">::</span> <span class="n">plain_name</span>
<a name="ln-1741"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>             <span class="kd">::</span> <span class="n">search_for</span>
<a name="ln-1742"></a><span class="kt">integer</span>                                  <span class="kd">::</span> <span class="n">lun</span>
<a name="ln-1743"></a><span class="kt">integer</span>                                  <span class="kd">::</span> <span class="n">ios</span>
<a name="ln-1744"></a><span class="kt">integer</span>                                  <span class="kd">::</span> <span class="n">itrim</span>
<a name="ln-1745"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">4096</span><span class="p">)</span>                      <span class="kd">::</span> <span class="n">line</span> <span class="c">!x! assuming input never this long</span>
<a name="ln-1746"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">256</span><span class="p">)</span>                       <span class="kd">::</span> <span class="n">message</span>
<a name="ln-1747"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>             <span class="kd">::</span> <span class="k">array</span><span class="p">(:)</span> <span class="c">! output array of tokens</span>
<a name="ln-1748"></a><span class="kt">integer</span>                                  <span class="kd">::</span> <span class="n">lines_processed</span>
<a name="ln-1749"></a>   <span class="n">lines_processed</span><span class="o">=</span><span class="mi">0</span>
<a name="ln-1750"></a>   <span class="n">plain_name</span><span class="o">=</span><span class="n">name</span><span class="o">//</span><span class="s1">&#39;  &#39;</span>
<a name="ln-1751"></a>   <span class="n">plain_name</span><span class="o">=</span><span class="nb">trim</span><span class="p">(</span><span class="n">name</span><span class="p">(</span><span class="mi">2</span><span class="p">:))</span>
<a name="ln-1752"></a>   <span class="n">os</span><span class="o">=</span> <span class="s1">&#39;@&#39;</span> <span class="o">//</span> <span class="n">get_env</span><span class="p">(</span><span class="s1">&#39;OSTYPE&#39;</span><span class="p">,</span><span class="n">get_env</span><span class="p">(</span><span class="s1">&#39;OS&#39;</span><span class="p">))</span>
<a name="ln-1753"></a>   <span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;GET_PROTOTYPE:OS=&#39;</span><span class="p">,</span><span class="n">OS</span>
<a name="ln-1754"></a>
<a name="ln-1755"></a>   <span class="n">search_for</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-1756"></a>   <span class="c">! look for NAME.rsp and see if there is an @OS  section in it and position to it and read</span>
<a name="ln-1757"></a>   <span class="k">if</span><span class="p">(</span><span class="n">os</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39;@&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1758"></a><span class="k">      </span><span class="n">search_for</span><span class="o">=</span><span class="n">os</span>
<a name="ln-1759"></a>      <span class="k">call </span><span class="n">find_and_read_response_file</span><span class="p">(</span><span class="n">plain_name</span><span class="p">)</span>
<a name="ln-1760"></a>      <span class="k">if</span><span class="p">(</span><span class="n">lines_processed</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">return</span>
<a name="ln-1761"></a><span class="k">   endif</span>
<a name="ln-1762"></a>
<a name="ln-1763"></a>   <span class="c">! look for NAME.rsp and see if there is anything before an OS-specific section</span>
<a name="ln-1764"></a>   <span class="n">search_for</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-1765"></a>   <span class="k">call </span><span class="n">find_and_read_response_file</span><span class="p">(</span><span class="n">plain_name</span><span class="p">)</span>
<a name="ln-1766"></a>   <span class="k">if</span><span class="p">(</span><span class="n">lines_processed</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">return</span>
<a name="ln-1767"></a>
<a name="ln-1768"></a>   <span class="c">! look for ARG0.rsp  with @OS@NAME  section in it and position to it</span>
<a name="ln-1769"></a>   <span class="k">if</span><span class="p">(</span><span class="n">os</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39;@&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1770"></a><span class="k">      </span><span class="n">search_for</span><span class="o">=</span><span class="n">os</span><span class="o">//</span><span class="n">name</span>
<a name="ln-1771"></a>      <span class="k">call </span><span class="n">find_and_read_response_file</span><span class="p">(</span><span class="n">basename</span><span class="p">(</span><span class="n">get_name</span><span class="p">(),</span><span class="n">suffix</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.))</span>
<a name="ln-1772"></a>      <span class="k">if</span><span class="p">(</span><span class="n">lines_processed</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">return</span>
<a name="ln-1773"></a><span class="k">   endif</span>
<a name="ln-1774"></a>
<a name="ln-1775"></a>   <span class="c">! look for ARG0.rsp  with a section called @NAME in it and position to it</span>
<a name="ln-1776"></a>   <span class="n">search_for</span><span class="o">=</span><span class="n">name</span>
<a name="ln-1777"></a>   <span class="k">call </span><span class="n">find_and_read_response_file</span><span class="p">(</span><span class="n">basename</span><span class="p">(</span><span class="n">get_name</span><span class="p">(),</span><span class="n">suffix</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.))</span>
<a name="ln-1778"></a>   <span class="k">if</span><span class="p">(</span><span class="n">lines_processed</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">return</span>
<a name="ln-1779"></a>
<a name="ln-1780"></a><span class="k">   write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;ERROR&gt; response name [&#39;</span><span class="o">//</span><span class="nb">trim</span><span class="p">(</span><span class="n">name</span><span class="p">)</span><span class="o">//</span><span class="s1">&#39;] not found&#39;</span>
<a name="ln-1781"></a>   <span class="k">stop </span><span class="mi">1</span>
<a name="ln-1782"></a><span class="k">contains</span>
<a name="ln-1783"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1784"></a><span class="k">subroutine </span><span class="n">find_and_read_response_file</span><span class="p">(</span><span class="n">rname</span><span class="p">)</span>
<a name="ln-1785"></a><span class="c">! search for a simple file named the same as the @NAME field with one entry assumed in it</span>
<a name="ln-1786"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>  <span class="kd">::</span> <span class="n">rname</span>
<a name="ln-1787"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">paths</span><span class="p">(:)</span>
<a name="ln-1788"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">testpath</span>
<a name="ln-1789"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">256</span><span class="p">)</span>           <span class="kd">::</span> <span class="n">message</span>
<a name="ln-1790"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">i</span>
<a name="ln-1791"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">ios</span>
<a name="ln-1792"></a>   <span class="n">prototype</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-1793"></a>   <span class="c">! look for NAME.rsp</span>
<a name="ln-1794"></a>   <span class="n">filename</span><span class="o">=</span><span class="n">rname</span><span class="o">//</span><span class="s1">&#39;.rsp&#39;</span>
<a name="ln-1795"></a>   <span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;FIND_AND_READ_RESPONSE_FILE:FILENAME=&#39;</span><span class="p">,</span><span class="n">filename</span>
<a name="ln-1796"></a>
<a name="ln-1797"></a>   <span class="c">! look for name.rsp in directories from environment variable assumed to be a colon-separated list of directories</span>
<a name="ln-1798"></a>   <span class="k">call </span><span class="n">split</span><span class="p">(</span><span class="n">get_env</span><span class="p">(</span><span class="s1">&#39;CLI_RESPONSE_PATH&#39;</span><span class="p">),</span><span class="n">paths</span><span class="p">)</span>
<a name="ln-1799"></a>   <span class="n">paths</span><span class="o">=</span><span class="p">[</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">paths</span><span class="p">))</span> <span class="kd">::</span> <span class="s1">&#39; &#39;</span><span class="p">,</span><span class="n">paths</span><span class="p">]</span>
<a name="ln-1800"></a>   <span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;FIND_AND_READ_RESPONSE_FILE:PATHS=&#39;</span><span class="p">,</span><span class="n">paths</span>
<a name="ln-1801"></a>
<a name="ln-1802"></a>   <span class="k">do </span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">paths</span><span class="p">)</span>
<a name="ln-1803"></a>      <span class="n">testpath</span><span class="o">=</span><span class="n">join_path</span><span class="p">(</span><span class="n">paths</span><span class="p">(</span><span class="n">i</span><span class="p">),</span><span class="n">filename</span><span class="p">)</span>
<a name="ln-1804"></a>      <span class="n">lun</span><span class="o">=</span><span class="n">fileopen</span><span class="p">(</span><span class="n">testpath</span><span class="p">,</span><span class="n">message</span><span class="p">)</span>
<a name="ln-1805"></a>      <span class="k">if</span><span class="p">(</span><span class="n">lun</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1806"></a><span class="k">         if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;FIND_AND_READ_RESPONSE_FILE:SEARCH_FOR=&#39;</span><span class="p">,</span><span class="n">search_for</span>
<a name="ln-1807"></a>         <span class="k">if</span><span class="p">(</span><span class="n">search_for</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39;&#39;</span><span class="p">)</span> <span class="k">call </span><span class="n">position_response</span><span class="p">()</span> <span class="c">! set to end of file or where string was found</span>
<a name="ln-1808"></a>         <span class="k">call </span><span class="n">process_response</span><span class="p">()</span>
<a name="ln-1809"></a>         <span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;FIND_AND_READ_RESPONSE_FILE:LINES_PROCESSED=&#39;</span><span class="p">,</span><span class="n">LINES_PROCESSED</span>
<a name="ln-1810"></a>         <span class="k">close</span><span class="p">(</span><span class="n">unit</span><span class="o">=</span><span class="n">lun</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">ios</span><span class="p">)</span>
<a name="ln-1811"></a>         <span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;FIND_AND_READ_RESPONSE_FILE:CLOSE:LUN=&#39;</span><span class="p">,</span><span class="n">LUN</span><span class="p">,</span><span class="s1">&#39; IOSTAT=&#39;</span><span class="p">,</span><span class="n">IOS</span>
<a name="ln-1812"></a>         <span class="k">if</span><span class="p">(</span><span class="n">lines_processed</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">exit</span>
<a name="ln-1813"></a><span class="k">      endif</span>
<a name="ln-1814"></a><span class="k">   enddo</span>
<a name="ln-1815"></a>
<a name="ln-1816"></a><span class="k">end subroutine </span><span class="n">find_and_read_response_file</span>
<a name="ln-1817"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1818"></a><span class="k">subroutine </span><span class="n">position_response</span><span class="p">()</span>
<a name="ln-1819"></a><span class="kt">integer</span> <span class="kd">::</span> <span class="n">ios</span>
<a name="ln-1820"></a>   <span class="n">line</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-1821"></a>   <span class="n">INFINITE</span><span class="p">:</span> <span class="k">do</span>
<a name="ln-1822"></a><span class="k">      read</span><span class="p">(</span><span class="n">unit</span><span class="o">=</span><span class="n">lun</span><span class="p">,</span><span class="n">fmt</span><span class="o">=</span><span class="s1">&#39;(a)&#39;</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">ios</span><span class="p">,</span><span class="n">iomsg</span><span class="o">=</span><span class="n">message</span><span class="p">)</span><span class="n">line</span>
<a name="ln-1823"></a>      <span class="k">if</span><span class="p">(</span><span class="nb">is_iostat_end</span><span class="p">(</span><span class="n">ios</span><span class="p">))</span><span class="k">then</span>
<a name="ln-1824"></a><span class="k">         if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;POSITION_RESPONSE:EOF&#39;</span>
<a name="ln-1825"></a>         <span class="k">backspace</span><span class="p">(</span><span class="n">lun</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">ios</span><span class="p">)</span>
<a name="ln-1826"></a>         <span class="k">exit </span><span class="n">INFINITE</span>
<a name="ln-1827"></a>      <span class="n">elseif</span><span class="p">(</span><span class="n">ios</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1828"></a><span class="k">         write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;ERROR&gt;*position_response*:&#39;</span><span class="o">//</span><span class="nb">trim</span><span class="p">(</span><span class="n">message</span><span class="p">)</span>
<a name="ln-1829"></a>         <span class="k">exit </span><span class="n">INFINITE</span>
<a name="ln-1830"></a>      <span class="k">endif</span>
<a name="ln-1831"></a><span class="k">      </span><span class="n">line</span><span class="o">=</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">line</span><span class="p">)</span>
<a name="ln-1832"></a>      <span class="k">if</span><span class="p">(</span><span class="n">line</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="n">search_for</span><span class="p">)</span><span class="k">return</span>
<a name="ln-1833"></a><span class="k">   enddo </span><span class="n">INFINITE</span>
<a name="ln-1834"></a><span class="k">end subroutine </span><span class="n">position_response</span>
<a name="ln-1835"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1836"></a><span class="k">subroutine </span><span class="n">process_response</span><span class="p">()</span>
<a name="ln-1837"></a>   <span class="n">line</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-1838"></a>   <span class="n">lines_processed</span><span class="o">=</span><span class="mi">0</span>
<a name="ln-1839"></a>      <span class="n">INFINITE</span><span class="p">:</span> <span class="k">do</span>
<a name="ln-1840"></a><span class="k">      read</span><span class="p">(</span><span class="n">unit</span><span class="o">=</span><span class="n">lun</span><span class="p">,</span><span class="n">fmt</span><span class="o">=</span><span class="s1">&#39;(a)&#39;</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">ios</span><span class="p">,</span><span class="n">iomsg</span><span class="o">=</span><span class="n">message</span><span class="p">)</span><span class="n">line</span>
<a name="ln-1841"></a>      <span class="k">if</span><span class="p">(</span><span class="nb">is_iostat_end</span><span class="p">(</span><span class="n">ios</span><span class="p">))</span><span class="k">then</span>
<a name="ln-1842"></a><span class="k">         backspace</span><span class="p">(</span><span class="n">lun</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">ios</span><span class="p">)</span>
<a name="ln-1843"></a>         <span class="k">exit </span><span class="n">INFINITE</span>
<a name="ln-1844"></a>      <span class="n">elseif</span><span class="p">(</span><span class="n">ios</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1845"></a><span class="k">         write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;ERROR&gt;*process_response*:&#39;</span><span class="o">//</span><span class="nb">trim</span><span class="p">(</span><span class="n">message</span><span class="p">)</span>
<a name="ln-1846"></a>         <span class="k">exit </span><span class="n">INFINITE</span>
<a name="ln-1847"></a>      <span class="k">endif</span>
<a name="ln-1848"></a><span class="k">      </span><span class="n">line</span><span class="o">=</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">line</span><span class="p">)</span>
<a name="ln-1849"></a>      <span class="k">if</span><span class="p">(</span><span class="nb">index</span><span class="p">(</span><span class="n">line</span><span class="o">//</span><span class="s1">&#39; &#39;</span><span class="p">,</span><span class="s1">&#39;#&#39;</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="mi">1</span><span class="p">)</span><span class="k">cycle</span>
<a name="ln-1850"></a><span class="k">      if</span><span class="p">(</span><span class="n">line</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39;&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1851"></a>
<a name="ln-1852"></a><span class="k">         if</span><span class="p">(</span><span class="nb">index</span><span class="p">(</span><span class="n">line</span><span class="p">,</span><span class="s1">&#39;@&#39;</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="mf">1.</span><span class="nb">and</span><span class="p">.</span><span class="n">lines_processed</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">exit </span><span class="n">INFINITE</span>
<a name="ln-1853"></a>
<a name="ln-1854"></a>         <span class="k">call </span><span class="n">split</span><span class="p">(</span><span class="n">line</span><span class="p">,</span><span class="k">array</span><span class="p">)</span> <span class="c">! get first word</span>
<a name="ln-1855"></a>         <span class="n">itrim</span><span class="o">=</span><span class="nb">len_trim</span><span class="p">(</span><span class="k">array</span><span class="p">(</span><span class="mi">1</span><span class="p">))</span><span class="o">+</span><span class="mi">2</span>
<a name="ln-1856"></a>         <span class="n">line</span><span class="o">=</span><span class="n">line</span><span class="p">(</span><span class="n">itrim</span><span class="p">:)</span>
<a name="ln-1857"></a>
<a name="ln-1858"></a>         <span class="n">PROCESS</span><span class="p">:</span> <span class="k">select case</span><span class="p">(</span><span class="n">lower</span><span class="p">(</span><span class="k">array</span><span class="p">(</span><span class="mi">1</span><span class="p">)))</span>
<a name="ln-1859"></a>         <span class="k">case</span><span class="p">(</span><span class="s1">&#39;comment&#39;</span><span class="p">,</span><span class="s1">&#39;#&#39;</span><span class="p">,</span><span class="s1">&#39;&#39;</span><span class="p">)</span>
<a name="ln-1860"></a>         <span class="k">case</span><span class="p">(</span><span class="s1">&#39;system&#39;</span><span class="p">,</span><span class="s1">&#39;!&#39;</span><span class="p">,</span><span class="s1">&#39;$&#39;</span><span class="p">)</span>
<a name="ln-1861"></a>            <span class="k">if</span><span class="p">(</span><span class="n">G_options_only</span><span class="p">)</span><span class="k">exit </span><span class="n">PROCESS</span>
<a name="ln-1862"></a>            <span class="n">lines_processed</span><span class="o">=</span> <span class="n">lines_processed</span><span class="o">+</span><span class="mi">1</span>
<a name="ln-1863"></a>            <span class="k">call </span><span class="nb">execute_command_line</span><span class="p">(</span><span class="n">line</span><span class="p">)</span>
<a name="ln-1864"></a>         <span class="k">case</span><span class="p">(</span><span class="s1">&#39;options&#39;</span><span class="p">,</span><span class="s1">&#39;option&#39;</span><span class="p">,</span><span class="s1">&#39;-&#39;</span><span class="p">)</span>
<a name="ln-1865"></a>            <span class="n">lines_processed</span><span class="o">=</span> <span class="n">lines_processed</span><span class="o">+</span><span class="mi">1</span>
<a name="ln-1866"></a>            <span class="n">prototype</span><span class="o">=</span><span class="n">prototype</span><span class="o">//</span><span class="s1">&#39; &#39;</span><span class="o">//</span><span class="nb">trim</span><span class="p">(</span><span class="n">line</span><span class="p">)</span>
<a name="ln-1867"></a>         <span class="k">case</span><span class="p">(</span><span class="s1">&#39;print&#39;</span><span class="p">,</span><span class="s1">&#39;&gt;&#39;</span><span class="p">,</span><span class="s1">&#39;echo&#39;</span><span class="p">)</span>
<a name="ln-1868"></a>            <span class="k">if</span><span class="p">(</span><span class="n">G_options_only</span><span class="p">)</span><span class="k">exit </span><span class="n">PROCESS</span>
<a name="ln-1869"></a>            <span class="n">lines_processed</span><span class="o">=</span> <span class="n">lines_processed</span><span class="o">+</span><span class="mi">1</span>
<a name="ln-1870"></a>            <span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="s1">&#39;(a)&#39;</span><span class="p">)</span><span class="nb">trim</span><span class="p">(</span><span class="n">line</span><span class="p">)</span>
<a name="ln-1871"></a>         <span class="k">case</span><span class="p">(</span><span class="s1">&#39;stop&#39;</span><span class="p">)</span>
<a name="ln-1872"></a>            <span class="k">if</span><span class="p">(</span><span class="n">G_options_only</span><span class="p">)</span><span class="k">exit </span><span class="n">PROCESS</span>
<a name="ln-1873"></a>            <span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="s1">&#39;(a)&#39;</span><span class="p">)</span><span class="nb">trim</span><span class="p">(</span><span class="n">line</span><span class="p">)</span>
<a name="ln-1874"></a>            <span class="k">stop</span>
<a name="ln-1875"></a><span class="k">         case </span><span class="n">default</span>
<a name="ln-1876"></a>            <span class="k">if</span><span class="p">(</span><span class="k">array</span><span class="p">(</span><span class="mi">1</span><span class="p">)(</span><span class="mi">1</span><span class="p">:</span><span class="mi">1</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="s1">&#39;@&#39;</span><span class="p">)</span><span class="k">cycle </span><span class="n">INFINITE</span> <span class="c">!skip adjacent @ lines from first</span>
<a name="ln-1877"></a>            <span class="n">lines_processed</span><span class="o">=</span> <span class="n">lines_processed</span><span class="o">+</span><span class="mi">1</span>
<a name="ln-1878"></a>            <span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="s1">&#39;(*(g0))&#39;</span><span class="p">)</span><span class="s1">&#39;unknown response keyword [&#39;</span><span class="p">,</span><span class="k">array</span><span class="p">(</span><span class="mi">1</span><span class="p">),</span><span class="s1">&#39;] with options of [&#39;</span><span class="p">,</span><span class="nb">trim</span><span class="p">(</span><span class="n">line</span><span class="p">),</span><span class="s1">&#39;]&#39;</span>
<a name="ln-1879"></a>         <span class="k">end select </span><span class="n">PROCESS</span>
<a name="ln-1880"></a>
<a name="ln-1881"></a>      <span class="k">endif</span>
<a name="ln-1882"></a><span class="k">      enddo </span><span class="n">INFINITE</span>
<a name="ln-1883"></a><span class="k">end subroutine </span><span class="n">process_response</span>
<a name="ln-1884"></a>
<a name="ln-1885"></a><span class="k">end subroutine </span><span class="n">get_prototype</span>
<a name="ln-1886"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1887"></a><span class="k">function </span><span class="n">fileopen</span><span class="p">(</span><span class="n">filename</span><span class="p">,</span><span class="n">message</span><span class="p">)</span> <span class="k">result</span><span class="p">(</span><span class="n">lun</span><span class="p">)</span>
<a name="ln-1888"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>              <span class="kd">::</span> <span class="n">filename</span>
<a name="ln-1889"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">),</span><span class="k">optional</span>    <span class="kd">::</span> <span class="n">message</span>
<a name="ln-1890"></a><span class="kt">integer</span>                                  <span class="kd">::</span> <span class="n">lun</span>
<a name="ln-1891"></a><span class="kt">integer</span>                                  <span class="kd">::</span> <span class="n">ios</span>
<a name="ln-1892"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">256</span><span class="p">)</span>                       <span class="kd">::</span> <span class="n">message_local</span>
<a name="ln-1893"></a>
<a name="ln-1894"></a>   <span class="n">ios</span><span class="o">=</span><span class="mi">0</span>
<a name="ln-1895"></a>   <span class="n">message_local</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-1896"></a>   <span class="k">open</span><span class="p">(</span><span class="k">file</span><span class="o">=</span><span class="n">filename</span><span class="p">,</span><span class="n">newunit</span><span class="o">=</span><span class="n">lun</span><span class="p">,&amp;</span>
<a name="ln-1897"></a>    <span class="p">&amp;</span> <span class="n">form</span><span class="o">=</span><span class="s1">&#39;formatted&#39;</span><span class="p">,</span><span class="nb">access</span><span class="o">=</span><span class="s1">&#39;sequential&#39;</span><span class="p">,</span><span class="n">action</span><span class="o">=</span><span class="s1">&#39;read&#39;</span><span class="p">,&amp;</span>
<a name="ln-1898"></a>    <span class="p">&amp;</span> <span class="n">position</span><span class="o">=</span><span class="s1">&#39;rewind&#39;</span><span class="p">,</span><span class="n">status</span><span class="o">=</span><span class="s1">&#39;old&#39;</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">ios</span><span class="p">,</span><span class="n">iomsg</span><span class="o">=</span><span class="n">message_local</span><span class="p">)</span>
<a name="ln-1899"></a>
<a name="ln-1900"></a>   <span class="k">if</span><span class="p">(</span><span class="n">ios</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1901"></a><span class="k">      </span><span class="n">lun</span><span class="o">=-</span><span class="mi">1</span>
<a name="ln-1902"></a>      <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">message</span><span class="p">))</span><span class="k">then</span>
<a name="ln-1903"></a><span class="k">         </span><span class="n">message</span><span class="o">=</span><span class="nb">trim</span><span class="p">(</span><span class="n">message_local</span><span class="p">)</span>
<a name="ln-1904"></a>      <span class="k">else</span>
<a name="ln-1905"></a><span class="k">         write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="nb">trim</span><span class="p">(</span><span class="n">message_local</span><span class="p">)</span>
<a name="ln-1906"></a>      <span class="k">endif</span>
<a name="ln-1907"></a><span class="k">   endif</span>
<a name="ln-1908"></a><span class="k">   if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;FILEOPEN:FILENAME=&#39;</span><span class="p">,</span><span class="n">filename</span><span class="p">,</span><span class="s1">&#39; LUN=&#39;</span><span class="p">,</span><span class="n">lun</span><span class="p">,</span><span class="s1">&#39; IOS=&#39;</span><span class="p">,</span><span class="n">IOS</span><span class="p">,</span><span class="s1">&#39; MESSAGE=&#39;</span><span class="p">,</span><span class="nb">trim</span><span class="p">(</span><span class="n">message_local</span><span class="p">)</span>
<a name="ln-1909"></a>
<a name="ln-1910"></a><span class="k">end function </span><span class="n">fileopen</span>
<a name="ln-1911"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1912"></a><span class="k">function </span><span class="n">get_env</span><span class="p">(</span><span class="n">NAME</span><span class="p">,</span><span class="n">DEFAULT</span><span class="p">)</span> <span class="k">result</span><span class="p">(</span><span class="k">VALUE</span><span class="p">)</span>
<a name="ln-1913"></a><span class="k">implicit none</span>
<a name="ln-1914"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">NAME</span>
<a name="ln-1915"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">DEFAULT</span>
<a name="ln-1916"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>         <span class="kd">::</span> <span class="k">VALUE</span>
<a name="ln-1917"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">howbig</span>
<a name="ln-1918"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="nb">stat</span>
<a name="ln-1919"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">length</span>
<a name="ln-1920"></a>   <span class="c">! get length required to hold value</span>
<a name="ln-1921"></a>   <span class="n">length</span><span class="o">=</span><span class="mi">0</span>
<a name="ln-1922"></a>   <span class="k">if</span><span class="p">(</span><span class="n">NAME</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39;&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1923"></a><span class="k">      call </span><span class="nb">get_environment_variable</span><span class="p">(</span><span class="n">NAME</span><span class="p">,</span> <span class="n">length</span><span class="o">=</span><span class="n">howbig</span><span class="p">,</span><span class="n">status</span><span class="o">=</span><span class="nb">stat</span><span class="p">,</span><span class="n">trim_name</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.)</span>
<a name="ln-1924"></a>      <span class="k">select case</span> <span class="p">(</span><span class="nb">stat</span><span class="p">)</span>
<a name="ln-1925"></a>      <span class="k">case</span> <span class="p">(</span><span class="mi">1</span><span class="p">)</span>
<a name="ln-1926"></a>          <span class="c">!x!print *, NAME, &quot; is not defined in the environment. Strange...&quot;</span>
<a name="ln-1927"></a>          <span class="k">VALUE</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-1928"></a>      <span class="k">case</span> <span class="p">(</span><span class="mi">2</span><span class="p">)</span>
<a name="ln-1929"></a>          <span class="c">!x!print *, &quot;This processor doesn&#39;t support environment variables. Boooh!&quot;</span>
<a name="ln-1930"></a>          <span class="k">VALUE</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-1931"></a>      <span class="k">case </span><span class="n">default</span>
<a name="ln-1932"></a>          <span class="c">! make string to hold value of sufficient size</span>
<a name="ln-1933"></a>          <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="k">value</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="k">value</span><span class="p">)</span>
<a name="ln-1934"></a>          <span class="k">allocate</span><span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="nb">max</span><span class="p">(</span><span class="n">howbig</span><span class="p">,</span><span class="mi">1</span><span class="p">))</span> <span class="kd">::</span> <span class="k">VALUE</span><span class="p">)</span>
<a name="ln-1935"></a>          <span class="c">! get value</span>
<a name="ln-1936"></a>         <span class="k">call </span><span class="nb">get_environment_variable</span><span class="p">(</span><span class="n">NAME</span><span class="p">,</span><span class="k">VALUE</span><span class="p">,</span><span class="n">status</span><span class="o">=</span><span class="nb">stat</span><span class="p">,</span><span class="n">trim_name</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.)</span>
<a name="ln-1937"></a>          <span class="k">if</span><span class="p">(</span><span class="nb">stat</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">VALUE</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-1938"></a>      <span class="k">end select</span>
<a name="ln-1939"></a><span class="k">   else</span>
<a name="ln-1940"></a><span class="k">      VALUE</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-1941"></a>   <span class="k">endif</span>
<a name="ln-1942"></a><span class="k">   if</span><span class="p">(</span><span class="k">VALUE</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="s1">&#39;&#39;</span><span class="p">.</span><span class="nb">and</span><span class="p">.</span><span class="nb">present</span><span class="p">(</span><span class="n">DEFAULT</span><span class="p">))</span><span class="k">VALUE</span><span class="o">=</span><span class="n">DEFAULT</span>
<a name="ln-1943"></a><span class="k">end function </span><span class="n">get_env</span>
<a name="ln-1944"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1945"></a><span class="k">function </span><span class="n">join_path</span><span class="p">(</span><span class="n">a1</span><span class="p">,</span><span class="n">a2</span><span class="p">,</span><span class="n">a3</span><span class="p">,</span><span class="n">a4</span><span class="p">,</span><span class="n">a5</span><span class="p">)</span> <span class="k">result</span><span class="p">(</span><span class="n">path</span><span class="p">)</span>
<a name="ln-1946"></a>   <span class="c">! Construct path by joining strings with os file separator</span>
<a name="ln-1947"></a>   <span class="c">!</span>
<a name="ln-1948"></a>   <span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span> <span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>           <span class="kd">::</span> <span class="n">a1</span><span class="p">,</span> <span class="n">a2</span>
<a name="ln-1949"></a>   <span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span> <span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span> <span class="k">optional</span> <span class="kd">::</span> <span class="n">a3</span><span class="p">,</span> <span class="n">a4</span><span class="p">,</span> <span class="n">a5</span>
<a name="ln-1950"></a>   <span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span> <span class="k">allocatable</span>          <span class="kd">::</span> <span class="n">path</span>
<a name="ln-1951"></a>   <span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">1</span><span class="p">)</span>                       <span class="kd">::</span> <span class="n">filesep</span>
<a name="ln-1952"></a>
<a name="ln-1953"></a>   <span class="n">filesep</span> <span class="o">=</span> <span class="n">separator</span><span class="p">()</span>
<a name="ln-1954"></a>   <span class="k">if</span><span class="p">(</span><span class="n">a1</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39;&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1955"></a><span class="k">      </span><span class="n">path</span> <span class="o">=</span> <span class="nb">trim</span><span class="p">(</span><span class="n">a1</span><span class="p">)</span> <span class="o">//</span> <span class="n">filesep</span> <span class="o">//</span> <span class="nb">trim</span><span class="p">(</span><span class="n">a2</span><span class="p">)</span>
<a name="ln-1956"></a>   <span class="k">else</span>
<a name="ln-1957"></a><span class="k">      </span><span class="n">path</span> <span class="o">=</span> <span class="nb">trim</span><span class="p">(</span><span class="n">a2</span><span class="p">)</span>
<a name="ln-1958"></a>   <span class="k">endif</span>
<a name="ln-1959"></a><span class="k">   if</span> <span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">a3</span><span class="p">))</span> <span class="n">path</span> <span class="o">=</span> <span class="n">path</span> <span class="o">//</span> <span class="n">filesep</span> <span class="o">//</span> <span class="nb">trim</span><span class="p">(</span><span class="n">a3</span><span class="p">)</span>
<a name="ln-1960"></a>   <span class="k">if</span> <span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">a4</span><span class="p">))</span> <span class="n">path</span> <span class="o">=</span> <span class="n">path</span> <span class="o">//</span> <span class="n">filesep</span> <span class="o">//</span> <span class="nb">trim</span><span class="p">(</span><span class="n">a4</span><span class="p">)</span>
<a name="ln-1961"></a>   <span class="k">if</span> <span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">a5</span><span class="p">))</span> <span class="n">path</span> <span class="o">=</span> <span class="n">path</span> <span class="o">//</span> <span class="n">filesep</span> <span class="o">//</span> <span class="nb">trim</span><span class="p">(</span><span class="n">a5</span><span class="p">)</span>
<a name="ln-1962"></a>   <span class="n">path</span><span class="o">=</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">path</span><span class="o">//</span><span class="s1">&#39;  &#39;</span><span class="p">)</span>
<a name="ln-1963"></a>   <span class="k">call </span><span class="n">substitute</span><span class="p">(</span><span class="n">path</span><span class="p">,</span><span class="n">filesep</span><span class="o">//</span><span class="n">filesep</span><span class="p">,</span><span class="s1">&#39;&#39;</span><span class="p">,</span><span class="n">start</span><span class="o">=</span><span class="mi">2</span><span class="p">)</span> <span class="c">! some systems allow names starting with &#39;//&#39; or &#39;\\&#39;</span>
<a name="ln-1964"></a>   <span class="n">path</span><span class="o">=</span><span class="nb">trim</span><span class="p">(</span><span class="n">path</span><span class="p">)</span>
<a name="ln-1965"></a><span class="k">end function </span><span class="n">join_path</span>
<a name="ln-1966"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1967"></a><span class="k">function </span><span class="n">get_name</span><span class="p">()</span> <span class="k">result</span><span class="p">(</span><span class="n">name</span><span class="p">)</span>
<a name="ln-1968"></a><span class="c">! get the pathname of arg0</span>
<a name="ln-1969"></a><span class="k">implicit none</span>
<a name="ln-1970"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">arg0</span>
<a name="ln-1971"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">arg0_length</span>
<a name="ln-1972"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">istat</span>
<a name="ln-1973"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">4096</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">long_name</span>
<a name="ln-1974"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">name</span>
<a name="ln-1975"></a>   <span class="n">arg0_length</span><span class="o">=</span><span class="mi">0</span>
<a name="ln-1976"></a>   <span class="n">name</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-1977"></a>   <span class="n">long_name</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-1978"></a>   <span class="k">call </span><span class="nb">get_command_argument</span><span class="p">(</span><span class="mi">0</span><span class="p">,</span><span class="n">length</span><span class="o">=</span><span class="n">arg0_length</span><span class="p">,</span><span class="n">status</span><span class="o">=</span><span class="n">istat</span><span class="p">)</span>
<a name="ln-1979"></a>   <span class="k">if</span><span class="p">(</span><span class="n">istat</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1980"></a><span class="k">      if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">arg0</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">arg0</span><span class="p">)</span>
<a name="ln-1981"></a>      <span class="k">allocate</span><span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="n">arg0_length</span><span class="p">)</span> <span class="kd">::</span> <span class="n">arg0</span><span class="p">)</span>
<a name="ln-1982"></a>      <span class="k">call </span><span class="nb">get_command_argument</span><span class="p">(</span><span class="mi">0</span><span class="p">,</span><span class="n">arg0</span><span class="p">,</span><span class="n">status</span><span class="o">=</span><span class="n">istat</span><span class="p">)</span>
<a name="ln-1983"></a>      <span class="k">if</span><span class="p">(</span><span class="n">istat</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-1984"></a><span class="k">         inquire</span><span class="p">(</span><span class="k">file</span><span class="o">=</span><span class="n">arg0</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">istat</span><span class="p">,</span><span class="n">name</span><span class="o">=</span><span class="n">long_name</span><span class="p">)</span>
<a name="ln-1985"></a>         <span class="n">name</span><span class="o">=</span><span class="nb">trim</span><span class="p">(</span><span class="n">long_name</span><span class="p">)</span>
<a name="ln-1986"></a>      <span class="k">else</span>
<a name="ln-1987"></a><span class="k">         </span><span class="n">name</span><span class="o">=</span><span class="n">arg0</span>
<a name="ln-1988"></a>      <span class="k">endif</span>
<a name="ln-1989"></a><span class="k">   endif</span>
<a name="ln-1990"></a><span class="k">end function </span><span class="n">get_name</span>
<a name="ln-1991"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-1992"></a><span class="k">function </span><span class="n">basename</span><span class="p">(</span><span class="n">path</span><span class="p">,</span><span class="n">suffix</span><span class="p">)</span> <span class="k">result</span> <span class="p">(</span><span class="n">base</span><span class="p">)</span>
<a name="ln-1993"></a>    <span class="c">! Extract filename from path with/without suffix</span>
<a name="ln-1994"></a>    <span class="c">!</span>
<a name="ln-1995"></a><span class="kt">character</span><span class="p">(</span><span class="o">*</span><span class="p">),</span> <span class="k">intent</span><span class="p">(</span><span class="n">In</span><span class="p">)</span> <span class="kd">::</span> <span class="n">path</span>
<a name="ln-1996"></a><span class="kt">logical</span><span class="p">,</span> <span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span> <span class="k">optional</span> <span class="kd">::</span> <span class="n">suffix</span>
<a name="ln-1997"></a><span class="kt">character</span><span class="p">(:),</span> <span class="k">allocatable</span> <span class="kd">::</span> <span class="n">base</span>
<a name="ln-1998"></a>
<a name="ln-1999"></a><span class="kt">character</span><span class="p">(:),</span> <span class="k">allocatable</span> <span class="kd">::</span> <span class="n">file_parts</span><span class="p">(:)</span>
<a name="ln-2000"></a><span class="kt">logical</span> <span class="kd">::</span> <span class="n">with_suffix</span>
<a name="ln-2001"></a>
<a name="ln-2002"></a>   <span class="k">if</span> <span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="nb">present</span><span class="p">(</span><span class="n">suffix</span><span class="p">))</span> <span class="k">then</span>
<a name="ln-2003"></a><span class="k">      </span><span class="n">with_suffix</span> <span class="o">=</span> <span class="p">.</span><span class="n">true</span><span class="p">.</span>
<a name="ln-2004"></a>   <span class="k">else</span>
<a name="ln-2005"></a><span class="k">      </span><span class="n">with_suffix</span> <span class="o">=</span> <span class="n">suffix</span>
<a name="ln-2006"></a>   <span class="k">endif</span>
<a name="ln-2007"></a>
<a name="ln-2008"></a><span class="k">   if</span> <span class="p">(</span><span class="n">with_suffix</span><span class="p">)</span> <span class="k">then</span>
<a name="ln-2009"></a><span class="k">      call </span><span class="n">split</span><span class="p">(</span><span class="n">path</span><span class="p">,</span><span class="n">file_parts</span><span class="p">,</span><span class="n">delimiters</span><span class="o">=</span><span class="s1">&#39;\/&#39;</span><span class="p">)</span>
<a name="ln-2010"></a>      <span class="k">if</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">file_parts</span><span class="p">).</span><span class="n">gt</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-2011"></a><span class="k">         </span><span class="n">base</span> <span class="o">=</span> <span class="nb">trim</span><span class="p">(</span><span class="n">file_parts</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">file_parts</span><span class="p">)))</span>
<a name="ln-2012"></a>      <span class="k">else</span>
<a name="ln-2013"></a><span class="k">         </span><span class="n">base</span> <span class="o">=</span> <span class="s1">&#39;&#39;</span>
<a name="ln-2014"></a>      <span class="k">endif</span>
<a name="ln-2015"></a><span class="k">   else</span>
<a name="ln-2016"></a><span class="k">      call </span><span class="n">split</span><span class="p">(</span><span class="n">path</span><span class="p">,</span><span class="n">file_parts</span><span class="p">,</span><span class="n">delimiters</span><span class="o">=</span><span class="s1">&#39;\/.&#39;</span><span class="p">)</span>
<a name="ln-2017"></a>      <span class="k">if</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">file_parts</span><span class="p">).</span><span class="n">ge</span><span class="p">.</span><span class="mi">2</span><span class="p">)</span><span class="k">then</span>
<a name="ln-2018"></a><span class="k">         </span><span class="n">base</span> <span class="o">=</span> <span class="nb">trim</span><span class="p">(</span><span class="n">file_parts</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">file_parts</span><span class="p">)</span><span class="o">-</span><span class="mi">1</span><span class="p">))</span>
<a name="ln-2019"></a>      <span class="k">else</span>
<a name="ln-2020"></a><span class="k">         </span><span class="n">base</span> <span class="o">=</span> <span class="s1">&#39;&#39;</span>
<a name="ln-2021"></a>      <span class="k">endif</span>
<a name="ln-2022"></a><span class="k">   endif</span>
<a name="ln-2023"></a><span class="k">end function </span><span class="n">basename</span>
<a name="ln-2024"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-2025"></a><span class="k">function </span><span class="n">separator2</span><span class="p">()</span> <span class="k">result</span><span class="p">(</span><span class="n">sep</span><span class="p">)</span>
<a name="ln-2026"></a><span class="c">! use the pathname returned as arg0 to determine pathname separator</span>
<a name="ln-2027"></a><span class="k">implicit none</span>
<a name="ln-2028"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">arg0</span>
<a name="ln-2029"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">arg0_length</span>
<a name="ln-2030"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">istat</span>
<a name="ln-2031"></a><span class="kt">logical</span>                      <span class="kd">::</span> <span class="n">existing</span>
<a name="ln-2032"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">1</span><span class="p">)</span>             <span class="kd">::</span> <span class="n">sep</span>
<a name="ln-2033"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">4096</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">name</span>
<a name="ln-2034"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">fname</span>
<a name="ln-2035"></a>   <span class="n">arg0_length</span><span class="o">=</span><span class="mi">0</span>
<a name="ln-2036"></a>   <span class="n">name</span><span class="o">=</span><span class="s1">&#39; &#39;</span>
<a name="ln-2037"></a>   <span class="k">call </span><span class="nb">get_command_argument</span><span class="p">(</span><span class="mi">0</span><span class="p">,</span><span class="n">length</span><span class="o">=</span><span class="n">arg0_length</span><span class="p">,</span><span class="n">status</span><span class="o">=</span><span class="n">istat</span><span class="p">)</span>
<a name="ln-2038"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">arg0</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">arg0</span><span class="p">)</span>
<a name="ln-2039"></a>   <span class="k">allocate</span><span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="n">arg0_length</span><span class="p">)</span> <span class="kd">::</span> <span class="n">arg0</span><span class="p">)</span>
<a name="ln-2040"></a>   <span class="k">call </span><span class="nb">get_command_argument</span><span class="p">(</span><span class="mi">0</span><span class="p">,</span><span class="n">arg0</span><span class="p">,</span><span class="n">status</span><span class="o">=</span><span class="n">istat</span><span class="p">)</span>
<a name="ln-2041"></a>   <span class="c">! check argument name</span>
<a name="ln-2042"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">index</span><span class="p">(</span><span class="n">arg0</span><span class="p">,</span><span class="s1">&#39;\&#39;).ne.0)then</span>
<a name="ln-2043"></a><span class="s1">      sep=&#39;</span><span class="err">\</span><span class="s1">&#39;</span>
<a name="ln-2044"></a><span class="s1">   elseif(index(arg0,&#39;</span><span class="o">/</span><span class="s1">&#39;).ne.0)then</span>
<a name="ln-2045"></a><span class="s1">      sep=&#39;</span><span class="o">/</span><span class="s1">&#39;</span>
<a name="ln-2046"></a><span class="s1">   else</span>
<a name="ln-2047"></a><span class="s1">      ! try name returned by INQUIRE(3f)</span>
<a name="ln-2048"></a><span class="s1">      existing=.false.</span>
<a name="ln-2049"></a><span class="s1">      name=&#39;</span> <span class="s1">&#39;</span>
<a name="ln-2050"></a><span class="s1">      inquire(file=arg0,iostat=istat,exist=existing,name=name)</span>
<a name="ln-2051"></a><span class="s1">      if(index(name,&#39;</span><span class="err">\</span><span class="s1">&#39;).ne.0)then</span>
<a name="ln-2052"></a><span class="s1">         sep=&#39;</span><span class="err">\</span><span class="s1">&#39;</span>
<a name="ln-2053"></a><span class="s1">      elseif(index(name,&#39;</span><span class="o">/</span><span class="s1">&#39;).ne.0)then</span>
<a name="ln-2054"></a><span class="s1">         sep=&#39;</span><span class="o">/</span><span class="s1">&#39;</span>
<a name="ln-2055"></a><span class="s1">      else</span>
<a name="ln-2056"></a><span class="s1">         ! well, try some common syntax and assume in current directory</span>
<a name="ln-2057"></a><span class="s1">         fname=&#39;</span><span class="p">.</span><span class="err">\</span><span class="s1">&#39;//arg0</span>
<a name="ln-2058"></a><span class="s1">         inquire(file=fname,iostat=istat,exist=existing)</span>
<a name="ln-2059"></a><span class="s1">         if(existing)then</span>
<a name="ln-2060"></a><span class="s1">            sep=&#39;</span><span class="o">/</span><span class="s1">&#39;</span>
<a name="ln-2061"></a><span class="s1">         else</span>
<a name="ln-2062"></a><span class="s1">            fname=&#39;</span><span class="p">.</span><span class="o">/</span><span class="s1">&#39;//arg0</span>
<a name="ln-2063"></a><span class="s1">            inquire(file=fname,iostat=istat,exist=existing)</span>
<a name="ln-2064"></a><span class="s1">            if(existing)then</span>
<a name="ln-2065"></a><span class="s1">               sep=&#39;</span><span class="o">/</span><span class="s1">&#39;</span>
<a name="ln-2066"></a><span class="s1">            else</span>
<a name="ln-2067"></a><span class="s1">               !x!write(*,gen)&#39;</span><span class="o">&lt;</span><span class="n">WARNING</span><span class="o">&gt;</span><span class="n">unknown</span> <span class="nb">system </span><span class="n">directory</span> <span class="n">path</span> <span class="n">separator</span><span class="s1">&#39;</span>
<a name="ln-2068"></a><span class="s1">               sep=&#39;</span><span class="o">/</span><span class="s1">&#39;</span>
<a name="ln-2069"></a><span class="s1">            endif</span>
<a name="ln-2070"></a><span class="s1">         endif</span>
<a name="ln-2071"></a><span class="s1">      endif</span>
<a name="ln-2072"></a><span class="s1">   endif</span>
<a name="ln-2073"></a><span class="s1">end function separator2</span>
<a name="ln-2074"></a><span class="s1">!===================================================================================================================================</span>
<a name="ln-2075"></a><span class="s1">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-2076"></a><span class="s1">!===================================================================================================================================</span>
<a name="ln-2077"></a><span class="s1">function separator() result(sep)</span>
<a name="ln-2078"></a><span class="s1">!&gt;</span>
<a name="ln-2079"></a><span class="s1">!!##NAME</span>
<a name="ln-2080"></a><span class="s1">!!    separator(3f) - [M_io:ENVIRONMENT] try to determine pathname directory separator character</span>
<a name="ln-2081"></a><span class="s1">!!    (LICENSE:PD)</span>
<a name="ln-2082"></a><span class="s1">!!</span>
<a name="ln-2083"></a><span class="s1">!!##SYNOPSIS</span>
<a name="ln-2084"></a><span class="s1">!!</span>
<a name="ln-2085"></a><span class="s1">!!    function separator() result(sep)</span>
<a name="ln-2086"></a><span class="s1">!!</span>
<a name="ln-2087"></a><span class="s1">!!     character(len=1) :: sep</span>
<a name="ln-2088"></a><span class="s1">!!</span>
<a name="ln-2089"></a><span class="s1">!!##DESCRIPTION</span>
<a name="ln-2090"></a><span class="s1">!!   First testing for the existence of &quot;/.&quot;,  then if that fails a list</span>
<a name="ln-2091"></a><span class="s1">!!   of variable names assumed to contain directory paths {PATH|HOME} are</span>
<a name="ln-2092"></a><span class="s1">!!   examined first for a backslash, then a slash.  Assuming basically the</span>
<a name="ln-2093"></a><span class="s1">!!   choice is a ULS or MSWindows system, and users can do weird things like</span>
<a name="ln-2094"></a><span class="s1">!!   put a backslash in a ULS path and break it.</span>
<a name="ln-2095"></a><span class="s1">!!</span>
<a name="ln-2096"></a><span class="s1">!!   Therefore can be very system dependent. If the queries fail the</span>
<a name="ln-2097"></a><span class="s1">!!   default returned is &quot;/&quot;.</span>
<a name="ln-2098"></a><span class="s1">!!</span>
<a name="ln-2099"></a><span class="s1">!!##EXAMPLE</span>
<a name="ln-2100"></a><span class="s1">!!</span>
<a name="ln-2101"></a><span class="s1">!!   sample usage</span>
<a name="ln-2102"></a><span class="s1">!!</span>
<a name="ln-2103"></a><span class="s1">!!    program demo_separator</span>
<a name="ln-2104"></a><span class="s1">!!    use M_io, only : separator</span>
<a name="ln-2105"></a><span class="s1">!!    implicit none</span>
<a name="ln-2106"></a><span class="s1">!!       write(*,*)&#39;</span><span class="n">separator</span><span class="o">=</span><span class="s1">&#39;,separator()</span>
<a name="ln-2107"></a><span class="s1">!!    end program demo_separator</span>
<a name="ln-2108"></a>
<a name="ln-2109"></a><span class="s1">! use the pathname returned as arg0 to determine pathname separator</span>
<a name="ln-2110"></a><span class="s1">implicit none</span>
<a name="ln-2111"></a><span class="s1">integer                      :: ios</span>
<a name="ln-2112"></a><span class="s1">integer                      :: i</span>
<a name="ln-2113"></a><span class="s1">logical                      :: existing=.false.</span>
<a name="ln-2114"></a><span class="s1">character(len=1)             :: sep</span>
<a name="ln-2115"></a><span class="s1">!x!IFORT BUG:character(len=1),save        :: sep_cache=&#39;</span> <span class="s1">&#39;</span>
<a name="ln-2116"></a><span class="s1">integer,save                 :: isep=-1</span>
<a name="ln-2117"></a><span class="s1">character(len=4096)          :: name</span>
<a name="ln-2118"></a><span class="s1">character(len=:),allocatable :: envnames(:)</span>
<a name="ln-2119"></a>
<a name="ln-2120"></a><span class="s1">    ! NOTE:  A parallel code might theoretically use multiple OS</span>
<a name="ln-2121"></a><span class="s1">    !x!FORT BUG:if(sep_cache.ne.&#39;</span> <span class="s1">&#39;)then  ! use cached value.</span>
<a name="ln-2122"></a><span class="s1">    !x!FORT BUG:    sep=sep_cache</span>
<a name="ln-2123"></a><span class="s1">    !x!FORT BUG:    return</span>
<a name="ln-2124"></a><span class="s1">    !x!FORT BUG:endif</span>
<a name="ln-2125"></a><span class="s1">    if(isep.ne.-1)then  ! use cached value.</span>
<a name="ln-2126"></a><span class="s1">        sep=char(isep)</span>
<a name="ln-2127"></a><span class="s1">        return</span>
<a name="ln-2128"></a><span class="s1">    endif</span>
<a name="ln-2129"></a><span class="s1">    FOUND: block</span>
<a name="ln-2130"></a><span class="s1">    ! simple, but does not work with ifort</span>
<a name="ln-2131"></a><span class="s1">    ! most MSWindows environments see to work with backslash even when</span>
<a name="ln-2132"></a><span class="s1">    ! using POSIX filenames to do not rely on &#39;</span><span class="err">\</span><span class="p">.</span><span class="s1">&#39;.</span>
<a name="ln-2133"></a><span class="s1">    inquire(file=&#39;</span><span class="o">/</span><span class="p">.</span><span class="s1">&#39;,exist=existing,iostat=ios,name=name)</span>
<a name="ln-2134"></a><span class="s1">    if(existing.and.ios.eq.0)then</span>
<a name="ln-2135"></a><span class="s1">        sep=&#39;</span><span class="o">/</span><span class="s1">&#39;</span>
<a name="ln-2136"></a><span class="s1">        exit FOUND</span>
<a name="ln-2137"></a><span class="s1">    endif</span>
<a name="ln-2138"></a><span class="s1">    ! check variables names common to many platforms that usually have a</span>
<a name="ln-2139"></a><span class="s1">    ! directory path in them although a ULS file can contain a backslash</span>
<a name="ln-2140"></a><span class="s1">    ! and vice-versa (eg. &quot;touch A\\B\\C&quot;). Removed HOMEPATH because it</span>
<a name="ln-2141"></a><span class="s1">    ! returned a name with backslash on CygWin, Mingw, WLS even when using</span>
<a name="ln-2142"></a><span class="s1">    ! POSIX filenames in the environment.</span>
<a name="ln-2143"></a><span class="s1">    envnames=[character(len=10) :: &#39;</span><span class="n">PATH</span><span class="s1">&#39;, &#39;</span><span class="n">HOME</span><span class="s1">&#39;]</span>
<a name="ln-2144"></a><span class="s1">    do i=1,size(envnames)</span>
<a name="ln-2145"></a><span class="s1">       if(index(get_env(envnames(i)),&#39;</span><span class="err">\</span><span class="s1">&#39;).ne.0)then</span>
<a name="ln-2146"></a><span class="s1">          sep=&#39;</span><span class="err">\</span><span class="s1">&#39;</span>
<a name="ln-2147"></a><span class="s1">          exit FOUND</span>
<a name="ln-2148"></a><span class="s1">       elseif(index(get_env(envnames(i)),&#39;</span><span class="o">/</span><span class="s1">&#39;).ne.0)then</span>
<a name="ln-2149"></a><span class="s1">          sep=&#39;</span><span class="o">/</span><span class="s1">&#39;</span>
<a name="ln-2150"></a><span class="s1">          exit FOUND</span>
<a name="ln-2151"></a><span class="s1">       endif</span>
<a name="ln-2152"></a><span class="s1">    enddo</span>
<a name="ln-2153"></a>
<a name="ln-2154"></a><span class="s1">    write(*,*)&#39;</span><span class="o">&lt;</span><span class="n">WARNING</span><span class="o">&gt;</span><span class="n">unknown</span> <span class="nb">system </span><span class="n">directory</span> <span class="n">path</span> <span class="n">separator</span><span class="s1">&#39;</span>
<a name="ln-2155"></a><span class="s1">    sep=&#39;</span><span class="err">\</span><span class="s1">&#39;</span>
<a name="ln-2156"></a><span class="s1">    endblock FOUND</span>
<a name="ln-2157"></a><span class="s1">    !x!IFORT BUG:sep_cache=sep</span>
<a name="ln-2158"></a><span class="s1">    isep=ichar(sep)</span>
<a name="ln-2159"></a><span class="s1">end function separator</span>
<a name="ln-2160"></a><span class="s1">!===================================================================================================================================</span>
<a name="ln-2161"></a><span class="s1">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-2162"></a><span class="s1">!===================================================================================================================================</span>
<a name="ln-2163"></a><span class="s1">subroutine cmd_args_to_dictionary()</span>
<a name="ln-2164"></a><span class="s1">! convert command line arguments to dictionary entries</span>
<a name="ln-2165"></a><span class="s1">!x!logical                      :: guess_if_value</span>
<a name="ln-2166"></a><span class="s1">integer                      :: pointer</span>
<a name="ln-2167"></a><span class="s1">character(len=:),allocatable :: lastkeyword</span>
<a name="ln-2168"></a><span class="s1">integer                      :: i, jj, kk</span>
<a name="ln-2169"></a><span class="s1">integer                      :: ilength, istatus, imax</span>
<a name="ln-2170"></a><span class="s1">character(len=1)             :: letter</span>
<a name="ln-2171"></a><span class="s1">character(len=:),allocatable :: current_argument</span>
<a name="ln-2172"></a><span class="s1">character(len=:),allocatable :: current_argument_padded</span>
<a name="ln-2173"></a><span class="s1">character(len=:),allocatable :: dummy</span>
<a name="ln-2174"></a><span class="s1">character(len=:),allocatable :: oldvalue</span>
<a name="ln-2175"></a><span class="s1">logical                      :: nomore</span>
<a name="ln-2176"></a><span class="s1">logical                      :: next_mandatory</span>
<a name="ln-2177"></a><span class="s1">   if(debug_m_cli2)write(*,gen)&#39;</span><span class="o">&lt;</span><span class="n">DEBUG</span><span class="o">&gt;</span><span class="n">CMD_ARGS_TO_DICTIONARY</span><span class="p">:</span><span class="n">START</span><span class="s1">&#39;</span>
<a name="ln-2178"></a><span class="s1">   next_mandatory=.false.</span>
<a name="ln-2179"></a><span class="s1">   nomore=.false.</span>
<a name="ln-2180"></a><span class="s1">   pointer=0</span>
<a name="ln-2181"></a><span class="s1">   lastkeyword=&#39;</span> <span class="s1">&#39;</span>
<a name="ln-2182"></a><span class="s1">   G_keyword_single_letter=.true.</span>
<a name="ln-2183"></a><span class="s1">   i=1</span>
<a name="ln-2184"></a><span class="s1">   GET_ARGS: do while (get_next_argument()) ! insert and replace entries</span>
<a name="ln-2185"></a>
<a name="ln-2186"></a><span class="s1">      if( current_argument .eq. &#39;</span><span class="o">-</span><span class="s1">&#39; .and. nomore .eqv. .true. )then   ! sort of</span>
<a name="ln-2187"></a><span class="s1">      elseif( current_argument .eq. &#39;</span><span class="o">-</span><span class="s1">&#39;)then                          ! sort of</span>
<a name="ln-2188"></a><span class="s1">         current_argument=&#39;</span><span class="s2">&quot;stdin&quot;</span><span class="s1">&#39;</span>
<a name="ln-2189"></a><span class="s1">      endif</span>
<a name="ln-2190"></a><span class="s1">      if( current_argument .eq. &#39;</span><span class="o">--</span><span class="s1">&#39; .and. nomore .eqv. .true. )then  ! -- was already encountered</span>
<a name="ln-2191"></a><span class="s1">      elseif( current_argument .eq. &#39;</span><span class="o">--</span><span class="s1">&#39; )then                        ! everything after this goes into the unnamed array</span>
<a name="ln-2192"></a><span class="s1">         nomore=.true.</span>
<a name="ln-2193"></a><span class="s1">         pointer=0</span>
<a name="ln-2194"></a><span class="s1">         if(G_remaining_option_allowed)then</span>
<a name="ln-2195"></a><span class="s1">            G_remaining_on=.true.</span>
<a name="ln-2196"></a><span class="s1">         endif</span>
<a name="ln-2197"></a><span class="s1">         cycle GET_ARGS</span>
<a name="ln-2198"></a><span class="s1">      endif</span>
<a name="ln-2199"></a>
<a name="ln-2200"></a><span class="s1">      dummy=current_argument//&#39;</span>   <span class="s1">&#39;</span>
<a name="ln-2201"></a><span class="s1">      current_argument_padded=current_argument//&#39;</span>   <span class="s1">&#39;</span>
<a name="ln-2202"></a>
<a name="ln-2203"></a><span class="s1">      !x!guess_if_value=maybe_value()</span>
<a name="ln-2204"></a>
<a name="ln-2205"></a><span class="s1">      if(.not.next_mandatory.and..not.nomore.and.current_argument_padded(1:2).eq.&#39;</span><span class="o">--</span><span class="s1">&#39;)then    ! beginning of long word</span>
<a name="ln-2206"></a><span class="s1">         G_keyword_single_letter=.false.</span>
<a name="ln-2207"></a><span class="s1">         if(lastkeyword.ne.&#39;&#39;)then</span>
<a name="ln-2208"></a><span class="s1">            call ifnull()</span>
<a name="ln-2209"></a><span class="s1">         endif</span>
<a name="ln-2210"></a><span class="s1">         call locate_key(current_argument_padded(3:),pointer)</span>
<a name="ln-2211"></a><span class="s1">         if(pointer.le.0)then</span>
<a name="ln-2212"></a><span class="s1">            if(G_QUIET)then</span>
<a name="ln-2213"></a><span class="s1">               lastkeyword=&quot;UNKNOWN&quot;</span>
<a name="ln-2214"></a><span class="s1">               pointer=0</span>
<a name="ln-2215"></a><span class="s1">               cycle GET_ARGS</span>
<a name="ln-2216"></a><span class="s1">            endif</span>
<a name="ln-2217"></a><span class="s1">            call print_dictionary(&#39;</span><span class="n">UNKNOWN</span> <span class="nb">LONG </span><span class="n">KEYWORD</span><span class="p">:</span> <span class="s1">&#39;//current_argument)</span>
<a name="ln-2218"></a><span class="s1">            call mystop(1)</span>
<a name="ln-2219"></a><span class="s1">            return</span>
<a name="ln-2220"></a><span class="s1">         endif</span>
<a name="ln-2221"></a><span class="s1">         lastkeyword=trim(current_argument_padded(3:))</span>
<a name="ln-2222"></a><span class="s1">         next_mandatory=mandatory(pointer)</span>
<a name="ln-2223"></a><span class="s1">      elseif(.not.next_mandatory &amp;</span>
<a name="ln-2224"></a><span class="s1">      &amp; .and..not.nomore &amp;</span>
<a name="ln-2225"></a><span class="s1">      &amp; .and.current_argument_padded(1:1).eq.&#39;</span><span class="o">-</span><span class="s1">&#39; &amp;</span>
<a name="ln-2226"></a><span class="s1">      &amp; .and.index(&quot;0123456789.&quot;,dummy(2:2)).eq.0)then</span>
<a name="ln-2227"></a><span class="s1">      ! short word</span>
<a name="ln-2228"></a><span class="s1">         G_keyword_single_letter=.true.</span>
<a name="ln-2229"></a><span class="s1">         if(lastkeyword.ne.&#39;&#39;)then</span>
<a name="ln-2230"></a><span class="s1">            call ifnull()</span>
<a name="ln-2231"></a><span class="s1">         endif</span>
<a name="ln-2232"></a><span class="s1">         call locate_key(current_argument_padded(2:),pointer)</span>
<a name="ln-2233"></a><span class="s1">         if(pointer.le.0)then</span>
<a name="ln-2234"></a><span class="s1">            jj=len(current_argument)</span>
<a name="ln-2235"></a><span class="s1">            if(G_STRICT.and.jj.gt.2)then  ! in strict mode this might be multiple single-character values</span>
<a name="ln-2236"></a><span class="s1">              do kk=2,jj</span>
<a name="ln-2237"></a><span class="s1">                 letter=current_argument_padded(kk:kk)</span>
<a name="ln-2238"></a><span class="s1">                 call locate_key(letter,pointer)</span>
<a name="ln-2239"></a><span class="s1">                 if(pointer.gt.0)then</span>
<a name="ln-2240"></a><span class="s1">                    call update(keywords(pointer),&#39;</span><span class="n">T</span><span class="s1">&#39;)</span>
<a name="ln-2241"></a><span class="s1">                 else</span>
<a name="ln-2242"></a><span class="s1">                    call print_dictionary(&#39;</span><span class="n">UNKNOWN</span> <span class="n">COMPOUND</span> <span class="nb">SHORT </span><span class="n">KEYWORD</span><span class="p">:</span><span class="s1">&#39;//letter//&#39;</span> <span class="n">in</span> <span class="s1">&#39;//current_argument)</span>
<a name="ln-2243"></a><span class="s1">                    if(G_QUIET)then</span>
<a name="ln-2244"></a><span class="s1">                       lastkeyword=&quot;UNKNOWN&quot;</span>
<a name="ln-2245"></a><span class="s1">                       pointer=0</span>
<a name="ln-2246"></a><span class="s1">                       cycle GET_ARGS</span>
<a name="ln-2247"></a><span class="s1">                    endif</span>
<a name="ln-2248"></a><span class="s1">                    call mystop(2)</span>
<a name="ln-2249"></a><span class="s1">                    return</span>
<a name="ln-2250"></a><span class="s1">                 endif</span>
<a name="ln-2251"></a><span class="s1">                 current_argument=&#39;</span><span class="o">-</span><span class="s1">&#39;//current_argument_padded(jj:jj)</span>
<a name="ln-2252"></a><span class="s1">              enddo</span>
<a name="ln-2253"></a><span class="s1">            else</span>
<a name="ln-2254"></a><span class="s1">               call print_dictionary(&#39;</span><span class="n">UNKNOWN</span> <span class="nb">SHORT </span><span class="n">KEYWORD</span><span class="p">:</span> <span class="s1">&#39;//current_argument)</span>
<a name="ln-2255"></a><span class="s1">               if(G_QUIET)then</span>
<a name="ln-2256"></a><span class="s1">                  lastkeyword=&quot;UNKNOWN&quot;</span>
<a name="ln-2257"></a><span class="s1">                  pointer=0</span>
<a name="ln-2258"></a><span class="s1">                  cycle GET_ARGS</span>
<a name="ln-2259"></a><span class="s1">               endif</span>
<a name="ln-2260"></a><span class="s1">               call mystop(2)</span>
<a name="ln-2261"></a><span class="s1">               return</span>
<a name="ln-2262"></a><span class="s1">            endif</span>
<a name="ln-2263"></a><span class="s1">         endif</span>
<a name="ln-2264"></a><span class="s1">         lastkeyword=trim(current_argument_padded(2:))</span>
<a name="ln-2265"></a><span class="s1">         next_mandatory=mandatory(pointer)</span>
<a name="ln-2266"></a><span class="s1">      elseif(pointer.eq.0)then                                       ! unnamed arguments</span>
<a name="ln-2267"></a><span class="s1">         if(G_remaining_on)then</span>
<a name="ln-2268"></a><span class="s1">            if(len(current_argument).lt.1)then</span>
<a name="ln-2269"></a><span class="s1">               G_remaining=G_remaining//&#39;</span><span class="s2">&quot;&quot;</span> <span class="s1">&#39;</span>
<a name="ln-2270"></a><span class="s1">            elseif(current_argument(1:1).eq.&#39;</span><span class="o">-</span><span class="s1">&#39;)then</span>
<a name="ln-2271"></a><span class="s1">               !get fancier to handle spaces and =!G_remaining=G_remaining//current_argument//&#39;</span> <span class="s1">&#39;</span>
<a name="ln-2272"></a><span class="s1">               G_remaining=G_remaining//&#39;</span><span class="s2">&quot;&#39;//current_argument//&#39;&quot;</span> <span class="s1">&#39;</span>
<a name="ln-2273"></a><span class="s1">            else</span>
<a name="ln-2274"></a><span class="s1">               G_remaining=G_remaining//&#39;</span><span class="s2">&quot;&#39;//current_argument//&#39;&quot;</span> <span class="s1">&#39;</span>
<a name="ln-2275"></a><span class="s1">            endif</span>
<a name="ln-2276"></a><span class="s1">            imax=max(len(args),len(current_argument))</span>
<a name="ln-2277"></a><span class="s1">            args=[character(len=imax) :: args,current_argument]</span>
<a name="ln-2278"></a><span class="s1">         else</span>
<a name="ln-2279"></a><span class="s1">            imax=max(len(unnamed),len(current_argument))</span>
<a name="ln-2280"></a><span class="s1">            if(index(current_argument//&#39;</span> <span class="s1">&#39;,&#39;</span><span class="err">@</span><span class="s1">&#39;).eq.1.and.G_response)then</span>
<a name="ln-2281"></a><span class="s1">               if(debug_m_cli2)write(*,gen)&#39;</span><span class="o">&lt;</span><span class="n">DEBUG</span><span class="o">&gt;</span><span class="n">CMD_ARGS_TO_DICTIONARY</span><span class="p">:</span><span class="mi">1</span><span class="p">:</span><span class="k">CALL </span><span class="n">EXPAND_RESPONSE</span><span class="p">:</span><span class="n">CURRENT_ARGUMENT</span><span class="o">=</span><span class="s1">&#39;,current_argument</span>
<a name="ln-2282"></a><span class="s1">               call expand_response(current_argument)</span>
<a name="ln-2283"></a><span class="s1">            else</span>
<a name="ln-2284"></a><span class="s1">               unnamed=[character(len=imax) :: unnamed,current_argument]</span>
<a name="ln-2285"></a><span class="s1">            endif</span>
<a name="ln-2286"></a><span class="s1">         endif</span>
<a name="ln-2287"></a><span class="s1">      else</span>
<a name="ln-2288"></a><span class="s1">         oldvalue=get(keywords(pointer))//&#39;</span> <span class="s1">&#39;</span>
<a name="ln-2289"></a><span class="s1">         if(oldvalue(1:1).eq.&#39;</span><span class="s2">&quot;&#39;)then</span>
<a name="ln-2290"></a><span class="s2">            current_argument=quote(current_argument(:ilength))</span>
<a name="ln-2291"></a><span class="s2">         endif</span>
<a name="ln-2292"></a><span class="s2">         if(upper(oldvalue).eq.&#39;F&#39;.or.upper(oldvalue).eq.&#39;T&#39;)then  ! assume boolean parameter</span>
<a name="ln-2293"></a><span class="s2">            if(current_argument.ne.&#39; &#39;)then</span>
<a name="ln-2294"></a><span class="s2">               if(G_remaining_on)then</span>
<a name="ln-2295"></a><span class="s2">                  if(len(current_argument).lt.1)then</span>
<a name="ln-2296"></a><span class="s2">                        G_remaining=G_remaining//&#39;&quot;&quot; &#39;</span>
<a name="ln-2297"></a><span class="s2">                  elseif(current_argument(1:1).eq.&#39;-&#39;)then</span>
<a name="ln-2298"></a><span class="s2">                       !get fancier to handle spaces and =!G_remaining=G_remaining//current_argument//&#39; &#39;</span>
<a name="ln-2299"></a><span class="s2">                        G_remaining=G_remaining//&#39;&quot;</span><span class="s1">&#39;//current_argument//&#39;</span><span class="s2">&quot; &#39;</span>
<a name="ln-2300"></a><span class="s2">                  else</span>
<a name="ln-2301"></a><span class="s2">                        G_remaining=G_remaining//&#39;&quot;</span><span class="s1">&#39;//current_argument//&#39;</span><span class="s2">&quot; &#39;</span>
<a name="ln-2302"></a><span class="s2">                  endif</span>
<a name="ln-2303"></a><span class="s2">                  imax=max(len(args),len(current_argument))</span>
<a name="ln-2304"></a><span class="s2">                  args=[character(len=imax) :: args,current_argument]</span>
<a name="ln-2305"></a><span class="s2">               else</span>
<a name="ln-2306"></a><span class="s2">                  imax=max(len(unnamed),len(current_argument))</span>
<a name="ln-2307"></a><span class="s2">                  if(index(current_argument//&#39; &#39;,&#39;@&#39;).eq.1.and.G_response)then</span>
<a name="ln-2308"></a><span class="s2">               if(debug_m_cli2)write(*,gen)&#39;&lt;DEBUG&gt;CMD_ARGS_TO_DICTIONARY:2:CALL EXPAND_RESPONSE:CURRENT_ARGUMENT=&#39;,current_argument</span>
<a name="ln-2309"></a><span class="s2">                     call expand_response(current_argument)</span>
<a name="ln-2310"></a><span class="s2">                  else</span>
<a name="ln-2311"></a><span class="s2">                     unnamed=[character(len=imax) :: unnamed,current_argument]</span>
<a name="ln-2312"></a><span class="s2">                  endif</span>
<a name="ln-2313"></a><span class="s2">               endif</span>
<a name="ln-2314"></a><span class="s2">            endif</span>
<a name="ln-2315"></a><span class="s2">            current_argument=&#39;T&#39;</span>
<a name="ln-2316"></a><span class="s2">         endif</span>
<a name="ln-2317"></a><span class="s2">         call update(keywords(pointer),current_argument)</span>
<a name="ln-2318"></a><span class="s2">         pointer=0</span>
<a name="ln-2319"></a><span class="s2">         lastkeyword=&#39;&#39;</span>
<a name="ln-2320"></a><span class="s2">         next_mandatory=.false.</span>
<a name="ln-2321"></a><span class="s2">      endif</span>
<a name="ln-2322"></a><span class="s2">   enddo GET_ARGS</span>
<a name="ln-2323"></a><span class="s2">   if(lastkeyword.ne.&#39;&#39;)then</span>
<a name="ln-2324"></a><span class="s2">      call ifnull()</span>
<a name="ln-2325"></a><span class="s2">   endif</span>
<a name="ln-2326"></a><span class="s2">   if(debug_m_cli2)write(*,gen)&#39;&lt;DEBUG&gt;CMD_ARGS_TO_DICTIONARY:NORMAL END&#39;</span>
<a name="ln-2327"></a>
<a name="ln-2328"></a><span class="s2">contains</span>
<a name="ln-2329"></a>
<a name="ln-2330"></a><span class="s2">subroutine ifnull()</span>
<a name="ln-2331"></a><span class="s2">   oldvalue=get(lastkeyword)//&#39; &#39;</span>
<a name="ln-2332"></a><span class="s2">   if(upper(oldvalue).eq.&#39;F&#39;.or.upper(oldvalue).eq.&#39;T&#39;)then</span>
<a name="ln-2333"></a><span class="s2">      call update(lastkeyword,&#39;T&#39;)</span>
<a name="ln-2334"></a><span class="s2">   elseif(oldvalue(1:1).eq.&#39;&quot;</span><span class="s1">&#39;)then</span>
<a name="ln-2335"></a><span class="s1">      call update(lastkeyword,&#39;</span><span class="s2">&quot; &quot;</span><span class="s1">&#39;)</span>
<a name="ln-2336"></a><span class="s1">   else</span>
<a name="ln-2337"></a><span class="s1">      call update(lastkeyword,&#39;</span> <span class="s1">&#39;)</span>
<a name="ln-2338"></a><span class="s1">   endif</span>
<a name="ln-2339"></a><span class="s1">end subroutine ifnull</span>
<a name="ln-2340"></a>
<a name="ln-2341"></a><span class="s1">function get_next_argument()</span>
<a name="ln-2342"></a><span class="s1">!</span>
<a name="ln-2343"></a><span class="s1">! get next argument from command line into allocated variable current_argument</span>
<a name="ln-2344"></a><span class="s1">!</span>
<a name="ln-2345"></a><span class="s1">logical,save :: hadequal=.false.</span>
<a name="ln-2346"></a><span class="s1">character(len=:),allocatable,save :: right_hand_side</span>
<a name="ln-2347"></a><span class="s1">logical :: get_next_argument</span>
<a name="ln-2348"></a><span class="s1">integer :: iright</span>
<a name="ln-2349"></a><span class="s1">integer :: iequal</span>
<a name="ln-2350"></a>
<a name="ln-2351"></a><span class="s1">   if(hadequal)then  ! use left-over value from previous -NAME=VALUE syntax</span>
<a name="ln-2352"></a><span class="s1">      current_argument=right_hand_side</span>
<a name="ln-2353"></a><span class="s1">      right_hand_side=&#39;&#39;</span>
<a name="ln-2354"></a><span class="s1">      hadequal=.false.</span>
<a name="ln-2355"></a><span class="s1">      get_next_argument=.true.</span>
<a name="ln-2356"></a><span class="s1">      ilength=len(current_argument)</span>
<a name="ln-2357"></a><span class="s1">      return</span>
<a name="ln-2358"></a><span class="s1">   endif</span>
<a name="ln-2359"></a>
<a name="ln-2360"></a><span class="s1">   if(i&gt;command_argument_count())then</span>
<a name="ln-2361"></a><span class="s1">      get_next_argument=.false.</span>
<a name="ln-2362"></a><span class="s1">      return</span>
<a name="ln-2363"></a><span class="s1">   else</span>
<a name="ln-2364"></a><span class="s1">      get_next_argument=.true.</span>
<a name="ln-2365"></a><span class="s1">   endif</span>
<a name="ln-2366"></a>
<a name="ln-2367"></a><span class="s1">   call get_command_argument(number=i,length=ilength,status=istatus)                              ! get next argument</span>
<a name="ln-2368"></a><span class="s1">   if(istatus /= 0) then                                                                          ! on error</span>
<a name="ln-2369"></a><span class="s1">      write(warn,*)&#39;</span><span class="o">*</span><span class="n">prototype_and_cmd_args_to_nlist</span><span class="o">*</span> <span class="n">error</span> <span class="n">obtaining</span> <span class="n">argument</span> <span class="s1">&#39;,i,&amp;</span>
<a name="ln-2370"></a><span class="s1">         &amp;&#39;</span><span class="n">status</span><span class="o">=</span><span class="s1">&#39;,istatus,&amp;</span>
<a name="ln-2371"></a><span class="s1">         &amp;&#39;</span><span class="n">length</span><span class="o">=</span><span class="s1">&#39;,ilength</span>
<a name="ln-2372"></a><span class="s1">      get_next_argument=.false.</span>
<a name="ln-2373"></a><span class="s1">   else</span>
<a name="ln-2374"></a><span class="s1">      ilength=max(ilength,1)</span>
<a name="ln-2375"></a><span class="s1">      if(allocated(current_argument))deallocate(current_argument)</span>
<a name="ln-2376"></a><span class="s1">      allocate(character(len=ilength) :: current_argument)</span>
<a name="ln-2377"></a><span class="s1">      call get_command_argument(number=i,value=current_argument,length=ilength,status=istatus)    ! get next argument</span>
<a name="ln-2378"></a><span class="s1">      if(istatus /= 0) then                                                                       ! on error</span>
<a name="ln-2379"></a><span class="s1">         write(warn,*)&#39;</span><span class="o">*</span><span class="n">prototype_and_cmd_args_to_nlist</span><span class="o">*</span> <span class="n">error</span> <span class="n">obtaining</span> <span class="n">argument</span> <span class="s1">&#39;,i,&amp;</span>
<a name="ln-2380"></a><span class="s1">            &amp;&#39;</span><span class="n">status</span><span class="o">=</span><span class="s1">&#39;,istatus,&amp;</span>
<a name="ln-2381"></a><span class="s1">            &amp;&#39;</span><span class="n">length</span><span class="o">=</span><span class="s1">&#39;,ilength,&amp;</span>
<a name="ln-2382"></a><span class="s1">            &amp;&#39;</span><span class="k">target </span><span class="n">length</span><span class="o">=</span><span class="s1">&#39;,len(current_argument)</span>
<a name="ln-2383"></a><span class="s1">         get_next_argument=.false.</span>
<a name="ln-2384"></a><span class="s1">       endif</span>
<a name="ln-2385"></a>
<a name="ln-2386"></a><span class="s1">       ! if an argument keyword and an equal before a space split on equal and save right hand side for next call</span>
<a name="ln-2387"></a><span class="s1">       if(nomore)then</span>
<a name="ln-2388"></a><span class="s1">       elseif(len(current_argument).eq.0)then</span>
<a name="ln-2389"></a><span class="s1">       else</span>
<a name="ln-2390"></a><span class="s1">          iright=index(current_argument,&#39;</span> <span class="s1">&#39;)</span>
<a name="ln-2391"></a><span class="s1">          if(iright.eq.0)iright=len(current_argument)</span>
<a name="ln-2392"></a><span class="s1">          iequal=index(current_argument(:iright),&#39;</span><span class="o">=</span><span class="s1">&#39;)</span>
<a name="ln-2393"></a><span class="s1">          if(next_mandatory)then</span>
<a name="ln-2394"></a><span class="s1">          elseif(iequal.ne.0.and.current_argument(1:1).eq.&#39;</span><span class="o">-</span><span class="s1">&#39;)then</span>
<a name="ln-2395"></a><span class="s1">             if(iequal.ne.len(current_argument))then</span>
<a name="ln-2396"></a><span class="s1">                right_hand_side=current_argument(iequal+1:)</span>
<a name="ln-2397"></a><span class="s1">             else</span>
<a name="ln-2398"></a><span class="s1">                right_hand_side=&#39;&#39;</span>
<a name="ln-2399"></a><span class="s1">             endif</span>
<a name="ln-2400"></a><span class="s1">             hadequal=.true.</span>
<a name="ln-2401"></a><span class="s1">             current_argument=current_argument(:iequal-1)</span>
<a name="ln-2402"></a><span class="s1">          endif</span>
<a name="ln-2403"></a><span class="s1">       endif</span>
<a name="ln-2404"></a><span class="s1">   endif</span>
<a name="ln-2405"></a><span class="s1">   i=i+1</span>
<a name="ln-2406"></a><span class="s1">end function get_next_argument</span>
<a name="ln-2407"></a>
<a name="ln-2408"></a><span class="s1">function maybe_value()</span>
<a name="ln-2409"></a><span class="s1">! if previous keyword value type is a string and it was</span>
<a name="ln-2410"></a><span class="s1">! given a null string because this value starts with a -</span>
<a name="ln-2411"></a><span class="s1">! try to see if this is a string value starting with a -</span>
<a name="ln-2412"></a><span class="s1">! to try to solve the vexing problem of values starting</span>
<a name="ln-2413"></a><span class="s1">! with a dash.</span>
<a name="ln-2414"></a><span class="s1">logical :: maybe_value</span>
<a name="ln-2415"></a><span class="s1">integer :: pointer</span>
<a name="ln-2416"></a><span class="s1">character(len=:),allocatable :: oldvalue</span>
<a name="ln-2417"></a>
<a name="ln-2418"></a><span class="s1">   oldvalue=get(lastkeyword)//&#39;</span> <span class="s1">&#39;</span>
<a name="ln-2419"></a><span class="s1">   if(current_argument_padded(1:1).ne.&#39;</span><span class="o">-</span><span class="s1">&#39;)then</span>
<a name="ln-2420"></a><span class="s1">      maybe_value=.true.</span>
<a name="ln-2421"></a><span class="s1">   elseif(oldvalue(1:1).ne.&#39;</span><span class="s2">&quot;&#39;)then</span>
<a name="ln-2422"></a><span class="s2">      maybe_value=.false.</span>
<a name="ln-2423"></a><span class="s2">   elseif(index(current_argument,&#39; &#39;).ne.0)then</span>
<a name="ln-2424"></a><span class="s2">      maybe_value=.true.</span>
<a name="ln-2425"></a><span class="s2">   elseif(scan(current_argument,&quot;</span><span class="p">,:;</span><span class="c">!@#$%^&amp;*+=()[]{}\|&#39;&quot;&quot;./&gt;&lt;?&quot;).ne.0)then</span>
<a name="ln-2426"></a>      <span class="n">maybe_value</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.</span>
<a name="ln-2427"></a>   <span class="k">else</span>  <span class="c">! the last value was a null string so see if this matches an allowed parameter</span>
<a name="ln-2428"></a>      <span class="k">pointer</span><span class="o">=</span><span class="mi">0</span>
<a name="ln-2429"></a>      <span class="k">if</span><span class="p">(</span><span class="n">current_argument_padded</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="mi">2</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="s1">&#39;--&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-2430"></a><span class="k">         call </span><span class="n">locate_key</span><span class="p">(</span><span class="n">current_argument_padded</span><span class="p">(</span><span class="mi">3</span><span class="p">:),</span><span class="k">pointer</span><span class="p">)</span>
<a name="ln-2431"></a>      <span class="n">elseif</span><span class="p">(</span><span class="n">current_argument_padded</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="mi">1</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="s1">&#39;-&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-2432"></a><span class="k">         call </span><span class="n">locate_key</span><span class="p">(</span><span class="n">current_argument_padded</span><span class="p">(</span><span class="mi">2</span><span class="p">:),</span><span class="k">pointer</span><span class="p">)</span>
<a name="ln-2433"></a>      <span class="k">endif</span>
<a name="ln-2434"></a><span class="k">      if</span><span class="p">(</span><span class="k">pointer</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-2435"></a><span class="k">         </span><span class="n">maybe_value</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.</span>
<a name="ln-2436"></a>      <span class="k">else</span>                   <span class="c">! matched an option name so LIKELY is not a value</span>
<a name="ln-2437"></a>         <span class="n">maybe_value</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>
<a name="ln-2438"></a>      <span class="k">endif</span>
<a name="ln-2439"></a><span class="k">   endif</span>
<a name="ln-2440"></a><span class="k">end function </span><span class="n">maybe_value</span>
<a name="ln-2441"></a>
<a name="ln-2442"></a><span class="k">end subroutine </span><span class="n">cmd_args_to_dictionary</span>
<a name="ln-2443"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-2444"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-2445"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-2446"></a><span class="c">!&gt;</span>
<a name="ln-2447"></a><span class="c">!!##NAME</span>
<a name="ln-2448"></a><span class="c">!!     print_dictionary(3f) - [ARGUMENTS:M_CLI2] print internal dictionary</span>
<a name="ln-2449"></a><span class="c">!!     created by calls to set_args(3f)</span>
<a name="ln-2450"></a><span class="c">!!     (LICENSE:PD)</span>
<a name="ln-2451"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-2452"></a><span class="c">!!</span>
<a name="ln-2453"></a><span class="c">!!     subroutine print_dictionary(header,stop)</span>
<a name="ln-2454"></a><span class="c">!!</span>
<a name="ln-2455"></a><span class="c">!!      character(len=*),intent(in),optional :: header</span>
<a name="ln-2456"></a><span class="c">!!      logical,intent(in),optional          :: stop</span>
<a name="ln-2457"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-2458"></a><span class="c">!!    Print the internal dictionary created by calls to set_args(3f).</span>
<a name="ln-2459"></a><span class="c">!!    This routine is intended to print the state of the argument list</span>
<a name="ln-2460"></a><span class="c">!!    if an error occurs in using the set_args(3f) procedure.</span>
<a name="ln-2461"></a><span class="c">!!##OPTIONS</span>
<a name="ln-2462"></a><span class="c">!!     HEADER  label to print before printing the state of the command</span>
<a name="ln-2463"></a><span class="c">!!             argument list.</span>
<a name="ln-2464"></a><span class="c">!!     STOP    logical value that if true stops the program after displaying</span>
<a name="ln-2465"></a><span class="c">!!             the dictionary.</span>
<a name="ln-2466"></a><span class="c">!!##EXAMPLE</span>
<a name="ln-2467"></a><span class="c">!!</span>
<a name="ln-2468"></a><span class="c">!!</span>
<a name="ln-2469"></a><span class="c">!!</span>
<a name="ln-2470"></a><span class="c">!! Typical usage:</span>
<a name="ln-2471"></a><span class="c">!!</span>
<a name="ln-2472"></a><span class="c">!!       program demo_print_dictionary</span>
<a name="ln-2473"></a><span class="c">!!       use M_CLI2,  only : set_args, get_args</span>
<a name="ln-2474"></a><span class="c">!!       implicit none</span>
<a name="ln-2475"></a><span class="c">!!       real :: x, y, z</span>
<a name="ln-2476"></a><span class="c">!!          call set_args(&#39;-x 10 -y 20 -z 30&#39;)</span>
<a name="ln-2477"></a><span class="c">!!          call get_args(&#39;x&#39;,x,&#39;y&#39;,y,&#39;z&#39;,z)</span>
<a name="ln-2478"></a><span class="c">!!          ! all done cracking the command line; use the values in your program.</span>
<a name="ln-2479"></a><span class="c">!!          write(*,*)x,y,z</span>
<a name="ln-2480"></a><span class="c">!!       end program demo_print_dictionary</span>
<a name="ln-2481"></a><span class="c">!!</span>
<a name="ln-2482"></a><span class="c">!!      Sample output</span>
<a name="ln-2483"></a><span class="c">!!</span>
<a name="ln-2484"></a><span class="c">!!      Calling the sample program with an unknown parameter or the --usage</span>
<a name="ln-2485"></a><span class="c">!!      switch produces the following:</span>
<a name="ln-2486"></a><span class="c">!!</span>
<a name="ln-2487"></a><span class="c">!!         $ ./demo_print_dictionary -A</span>
<a name="ln-2488"></a><span class="c">!!         UNKNOWN SHORT KEYWORD: -A</span>
<a name="ln-2489"></a><span class="c">!!         KEYWORD             PRESENT  VALUE</span>
<a name="ln-2490"></a><span class="c">!!         z                   F        [3]</span>
<a name="ln-2491"></a><span class="c">!!         y                   F        [2]</span>
<a name="ln-2492"></a><span class="c">!!         x                   F        [1]</span>
<a name="ln-2493"></a><span class="c">!!         help                F        [F]</span>
<a name="ln-2494"></a><span class="c">!!         version             F        [F]</span>
<a name="ln-2495"></a><span class="c">!!         usage               F        [F]</span>
<a name="ln-2496"></a><span class="c">!!</span>
<a name="ln-2497"></a><span class="c">!!##AUTHOR</span>
<a name="ln-2498"></a><span class="c">!!      John S. Urban, 2019</span>
<a name="ln-2499"></a><span class="c">!!##LICENSE</span>
<a name="ln-2500"></a><span class="c">!!      Public Domain</span>
<a name="ln-2501"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-2502"></a><span class="k">subroutine </span><span class="n">print_dictionary</span><span class="p">(</span><span class="n">header</span><span class="p">,</span><span class="k">stop</span><span class="p">)</span>
<a name="ln-2503"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">header</span>
<a name="ln-2504"></a><span class="kt">logical</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>          <span class="kd">::</span> <span class="k">stop</span>
<a name="ln-2505"></a><span class="kt">integer</span>          <span class="kd">::</span> <span class="n">i</span>
<a name="ln-2506"></a>   <span class="k">if</span><span class="p">(</span><span class="n">G_QUIET</span><span class="p">)</span><span class="k">return</span>
<a name="ln-2507"></a><span class="k">   if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">header</span><span class="p">))</span><span class="k">then</span>
<a name="ln-2508"></a><span class="k">      if</span><span class="p">(</span><span class="n">header</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39;&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-2509"></a><span class="k">         write</span><span class="p">(</span><span class="n">warn</span><span class="p">,</span><span class="s1">&#39;(a)&#39;</span><span class="p">)</span><span class="n">header</span>
<a name="ln-2510"></a>      <span class="k">endif</span>
<a name="ln-2511"></a><span class="k">   endif</span>
<a name="ln-2512"></a><span class="k">   if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">keywords</span><span class="p">))</span><span class="k">then</span>
<a name="ln-2513"></a><span class="k">      if</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">keywords</span><span class="p">).</span><span class="n">gt</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-2514"></a><span class="k">         write</span><span class="p">(</span><span class="n">warn</span><span class="p">,</span><span class="s1">&#39;(a,1x,a,1x,a,1x,a)&#39;</span><span class="p">)</span><span class="n">atleast</span><span class="p">(</span><span class="s1">&#39;KEYWORD&#39;</span><span class="p">,</span><span class="nb">max</span><span class="p">(</span><span class="nb">len</span><span class="p">(</span><span class="n">keywords</span><span class="p">),</span><span class="mi">8</span><span class="p">)),</span><span class="s1">&#39;SHORT&#39;</span><span class="p">,</span><span class="s1">&#39;PRESENT&#39;</span><span class="p">,</span><span class="s1">&#39;VALUE&#39;</span>
<a name="ln-2515"></a>         <span class="k">write</span><span class="p">(</span><span class="n">warn</span><span class="p">,</span><span class="s1">&#39;(*(a,1x,a5,1x,l1,8x,&quot;[&quot;,a,&quot;]&quot;,/))&#39;</span><span class="p">)</span> <span class="p">&amp;</span>
<a name="ln-2516"></a>         <span class="p">&amp;</span> <span class="p">(</span><span class="n">atleast</span><span class="p">(</span><span class="n">keywords</span><span class="p">(</span><span class="n">i</span><span class="p">),</span><span class="nb">max</span><span class="p">(</span><span class="nb">len</span><span class="p">(</span><span class="n">keywords</span><span class="p">),</span><span class="mi">8</span><span class="p">)),</span><span class="n">shorts</span><span class="p">(</span><span class="n">i</span><span class="p">),</span><span class="n">present_in</span><span class="p">(</span><span class="n">i</span><span class="p">),</span><span class="n">values</span><span class="p">(</span><span class="n">i</span><span class="p">)(:</span><span class="n">counts</span><span class="p">(</span><span class="n">i</span><span class="p">)),</span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">keywords</span><span class="p">))</span>
<a name="ln-2517"></a>      <span class="k">endif</span>
<a name="ln-2518"></a><span class="k">   endif</span>
<a name="ln-2519"></a><span class="k">   if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">unnamed</span><span class="p">))</span><span class="k">then</span>
<a name="ln-2520"></a><span class="k">      if</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">unnamed</span><span class="p">).</span><span class="n">gt</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-2521"></a><span class="k">         write</span><span class="p">(</span><span class="n">warn</span><span class="p">,</span><span class="s1">&#39;(a)&#39;</span><span class="p">)</span><span class="s1">&#39;UNNAMED&#39;</span>
<a name="ln-2522"></a>         <span class="k">write</span><span class="p">(</span><span class="n">warn</span><span class="p">,</span><span class="s1">&#39;(i6.6,3a)&#39;</span><span class="p">)(</span><span class="n">i</span><span class="p">,</span><span class="s1">&#39;[&#39;</span><span class="p">,</span><span class="n">unnamed</span><span class="p">(</span><span class="n">i</span><span class="p">),</span><span class="s1">&#39;]&#39;</span><span class="p">,</span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">unnamed</span><span class="p">))</span>
<a name="ln-2523"></a>      <span class="k">endif</span>
<a name="ln-2524"></a><span class="k">   endif</span>
<a name="ln-2525"></a><span class="k">   if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">args</span><span class="p">))</span><span class="k">then</span>
<a name="ln-2526"></a><span class="k">      if</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">args</span><span class="p">).</span><span class="n">gt</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-2527"></a><span class="k">         write</span><span class="p">(</span><span class="n">warn</span><span class="p">,</span><span class="s1">&#39;(a)&#39;</span><span class="p">)</span><span class="s1">&#39;ARGS&#39;</span>
<a name="ln-2528"></a>         <span class="k">write</span><span class="p">(</span><span class="n">warn</span><span class="p">,</span><span class="s1">&#39;(i6.6,3a)&#39;</span><span class="p">)(</span><span class="n">i</span><span class="p">,</span><span class="s1">&#39;[&#39;</span><span class="p">,</span><span class="n">args</span><span class="p">(</span><span class="n">i</span><span class="p">),</span><span class="s1">&#39;]&#39;</span><span class="p">,</span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">args</span><span class="p">))</span>
<a name="ln-2529"></a>      <span class="k">endif</span>
<a name="ln-2530"></a><span class="k">   endif</span>
<a name="ln-2531"></a><span class="k">   if</span><span class="p">(</span><span class="n">G_remaining</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39;&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-2532"></a><span class="k">      write</span><span class="p">(</span><span class="n">warn</span><span class="p">,</span><span class="s1">&#39;(a)&#39;</span><span class="p">)</span><span class="s1">&#39;REMAINING&#39;</span>
<a name="ln-2533"></a>      <span class="k">write</span><span class="p">(</span><span class="n">warn</span><span class="p">,</span><span class="s1">&#39;(a)&#39;</span><span class="p">)</span><span class="n">G_remaining</span>
<a name="ln-2534"></a>   <span class="k">endif</span>
<a name="ln-2535"></a><span class="k">   if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="k">stop</span><span class="p">))</span><span class="k">then</span>
<a name="ln-2536"></a><span class="k">      if</span><span class="p">(</span><span class="k">stop</span><span class="p">)</span> <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">5</span><span class="p">)</span>
<a name="ln-2537"></a>   <span class="k">endif</span>
<a name="ln-2538"></a><span class="k">end subroutine </span><span class="n">print_dictionary</span>
<a name="ln-2539"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-2540"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-2541"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-2542"></a><span class="k">FUNCTION </span><span class="n">strtok</span><span class="p">(</span><span class="n">source_string</span><span class="p">,</span><span class="n">itoken</span><span class="p">,</span><span class="n">token_start</span><span class="p">,</span><span class="n">token_end</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span> <span class="k">result</span><span class="p">(</span><span class="n">strtok_status</span><span class="p">)</span>
<a name="ln-2543"></a><span class="c">! JSU- 20151030</span>
<a name="ln-2544"></a>
<a name="ln-2545"></a><span class="c">! ident_6=&quot;@(#)M_CLI2::strtok(3f): Tokenize a string&quot;</span>
<a name="ln-2546"></a>
<a name="ln-2547"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>  <span class="kd">::</span> <span class="n">source_string</span>    <span class="c">! Source string to tokenize.</span>
<a name="ln-2548"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>  <span class="kd">::</span> <span class="n">delimiters</span>       <span class="c">! list of separator characters. May change between calls</span>
<a name="ln-2549"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">inout</span><span class="p">)</span>        <span class="kd">::</span> <span class="n">itoken</span>           <span class="c">! token count since started</span>
<a name="ln-2550"></a><span class="kt">logical</span>                      <span class="kd">::</span> <span class="n">strtok_status</span>    <span class="c">! returned value</span>
<a name="ln-2551"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">token_start</span>      <span class="c">! beginning of token found if function result is .true.</span>
<a name="ln-2552"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">inout</span><span class="p">)</span>        <span class="kd">::</span> <span class="n">token_end</span>        <span class="c">! end of token found if function result is .true.</span>
<a name="ln-2553"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">isource_len</span>
<a name="ln-2554"></a><span class="c">!----------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-2555"></a><span class="c">!  calculate where token_start should start for this pass</span>
<a name="ln-2556"></a>   <span class="k">if</span><span class="p">(</span><span class="n">itoken</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>                           <span class="c">! this is assumed to be the first call</span>
<a name="ln-2557"></a>      <span class="n">token_start</span><span class="o">=</span><span class="mi">1</span>
<a name="ln-2558"></a>   <span class="k">else</span>                                          <span class="c">! increment start to previous end + 1</span>
<a name="ln-2559"></a>      <span class="n">token_start</span><span class="o">=</span><span class="n">token_end</span><span class="o">+</span><span class="mi">1</span>
<a name="ln-2560"></a>   <span class="k">endif</span>
<a name="ln-2561"></a><span class="c">!----------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-2562"></a>   <span class="n">isource_len</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">source_string</span><span class="p">)</span>                <span class="c">! length of input string</span>
<a name="ln-2563"></a><span class="c">!----------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-2564"></a>   <span class="k">if</span><span class="p">(</span><span class="n">token_start</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="n">isource_len</span><span class="p">)</span><span class="k">then</span>            <span class="c">! user input error or at end of string</span>
<a name="ln-2565"></a>      <span class="n">token_end</span><span class="o">=</span><span class="n">isource_len</span>                      <span class="c">! assume end of token is end of string until proven otherwise so it is set</span>
<a name="ln-2566"></a>      <span class="n">strtok_status</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>
<a name="ln-2567"></a>      <span class="k">return</span>
<a name="ln-2568"></a><span class="k">   endif</span>
<a name="ln-2569"></a><span class="c">!----------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-2570"></a>   <span class="c">! find beginning of token</span>
<a name="ln-2571"></a>   <span class="k">do while</span> <span class="p">(</span><span class="n">token_start</span> <span class="p">.</span><span class="n">le</span><span class="p">.</span> <span class="n">isource_len</span><span class="p">)</span>       <span class="c">! step thru each character to find next delimiter, if any</span>
<a name="ln-2572"></a>      <span class="k">if</span><span class="p">(</span><span class="nb">index</span><span class="p">(</span><span class="n">delimiters</span><span class="p">,</span><span class="n">source_string</span><span class="p">(</span><span class="n">token_start</span><span class="p">:</span><span class="n">token_start</span><span class="p">))</span> <span class="p">.</span><span class="n">ne</span><span class="p">.</span> <span class="mi">0</span><span class="p">)</span> <span class="k">then</span>
<a name="ln-2573"></a><span class="k">         </span><span class="n">token_start</span> <span class="o">=</span> <span class="n">token_start</span> <span class="o">+</span> <span class="mi">1</span>
<a name="ln-2574"></a>      <span class="k">else</span>
<a name="ln-2575"></a><span class="k">         exit</span>
<a name="ln-2576"></a><span class="k">      endif</span>
<a name="ln-2577"></a><span class="k">   enddo</span>
<a name="ln-2578"></a><span class="c">!----------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-2579"></a>   <span class="n">token_end</span><span class="o">=</span><span class="n">token_start</span>
<a name="ln-2580"></a>   <span class="k">do while</span> <span class="p">(</span><span class="n">token_end</span> <span class="p">.</span><span class="n">le</span><span class="p">.</span> <span class="n">isource_len</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span>       <span class="c">! step thru each character to find next delimiter, if any</span>
<a name="ln-2581"></a>      <span class="k">if</span><span class="p">(</span><span class="nb">index</span><span class="p">(</span><span class="n">delimiters</span><span class="p">,</span><span class="n">source_string</span><span class="p">(</span><span class="n">token_end</span><span class="o">+</span><span class="mi">1</span><span class="p">:</span><span class="n">token_end</span><span class="o">+</span><span class="mi">1</span><span class="p">))</span> <span class="p">.</span><span class="n">ne</span><span class="p">.</span> <span class="mi">0</span><span class="p">)</span> <span class="k">then</span>  <span class="c">! found a delimiter in next character</span>
<a name="ln-2582"></a>         <span class="k">exit</span>
<a name="ln-2583"></a><span class="k">      endif</span>
<a name="ln-2584"></a><span class="k">      </span><span class="n">token_end</span> <span class="o">=</span> <span class="n">token_end</span> <span class="o">+</span> <span class="mi">1</span>
<a name="ln-2585"></a>   <span class="k">enddo</span>
<a name="ln-2586"></a><span class="c">!----------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-2587"></a>   <span class="k">if</span> <span class="p">(</span><span class="n">token_start</span> <span class="p">.</span><span class="n">gt</span><span class="p">.</span> <span class="n">isource_len</span><span class="p">)</span> <span class="k">then</span>        <span class="c">! determine if finished</span>
<a name="ln-2588"></a>      <span class="n">strtok_status</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>                      <span class="c">! flag that input string has been completely processed</span>
<a name="ln-2589"></a>   <span class="k">else</span>
<a name="ln-2590"></a><span class="k">      </span><span class="n">itoken</span><span class="o">=</span><span class="n">itoken</span><span class="o">+</span><span class="mi">1</span>                            <span class="c">! increment count of tokens found</span>
<a name="ln-2591"></a>      <span class="n">strtok_status</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.</span>                       <span class="c">! flag more tokens may remain</span>
<a name="ln-2592"></a>   <span class="k">endif</span>
<a name="ln-2593"></a><span class="c">!----------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-2594"></a><span class="k">end function </span><span class="n">strtok</span>
<a name="ln-2595"></a><span class="c">!==================================================================================================================================!</span>
<a name="ln-2596"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-2597"></a><span class="c">!==================================================================================================================================!</span>
<a name="ln-2598"></a><span class="c">!&gt;</span>
<a name="ln-2599"></a><span class="c">!!##NAME</span>
<a name="ln-2600"></a><span class="c">!!     get_args(3f) - [ARGUMENTS:M_CLI2] return keyword values when parsing</span>
<a name="ln-2601"></a><span class="c">!!     command line arguments</span>
<a name="ln-2602"></a><span class="c">!!     (LICENSE:PD)</span>
<a name="ln-2603"></a><span class="c">!!</span>
<a name="ln-2604"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-2605"></a><span class="c">!!</span>
<a name="ln-2606"></a><span class="c">!!   get_args(3f) and its convenience functions:</span>
<a name="ln-2607"></a><span class="c">!!</span>
<a name="ln-2608"></a><span class="c">!!     use M_CLI2, only : get_args</span>
<a name="ln-2609"></a><span class="c">!!     ! convenience functions</span>
<a name="ln-2610"></a><span class="c">!!     use M_CLI2, only : dget, iget, lget, rget, sget, cget</span>
<a name="ln-2611"></a><span class="c">!!     use M_CLI2, only : dgets, igets, lgets, rgets, sgets, cgets</span>
<a name="ln-2612"></a><span class="c">!!</span>
<a name="ln-2613"></a><span class="c">!!     subroutine get_args(name,value,delimiters)</span>
<a name="ln-2614"></a><span class="c">!!</span>
<a name="ln-2615"></a><span class="c">!!      character(len=*),intent(in) :: name</span>
<a name="ln-2616"></a><span class="c">!!</span>
<a name="ln-2617"></a><span class="c">!!      type(${TYPE}),allocatable,intent(out) :: value(:)</span>
<a name="ln-2618"></a><span class="c">!!      ! or</span>
<a name="ln-2619"></a><span class="c">!!      type(${TYPE}),allocatable,intent(out) :: value</span>
<a name="ln-2620"></a><span class="c">!!</span>
<a name="ln-2621"></a><span class="c">!!      character(len=*),intent(in),optional :: delimiters</span>
<a name="ln-2622"></a><span class="c">!!</span>
<a name="ln-2623"></a><span class="c">!!      where ${TYPE} may be from the set</span>
<a name="ln-2624"></a><span class="c">!!              {real,doubleprecision,integer,logical,complex,character(len=:)}</span>
<a name="ln-2625"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-2626"></a><span class="c">!!</span>
<a name="ln-2627"></a><span class="c">!!    GET_ARGS(3f) returns the value of keywords after SET_ARGS(3f)</span>
<a name="ln-2628"></a><span class="c">!!    has been called. For fixed-length CHARACTER variables</span>
<a name="ln-2629"></a><span class="c">!!    see GET_ARGS_FIXED_LENGTH(3f). For fixed-size arrays see</span>
<a name="ln-2630"></a><span class="c">!!    GET_ARGS_FIXED_SIZE(3f).</span>
<a name="ln-2631"></a><span class="c">!!</span>
<a name="ln-2632"></a><span class="c">!!    As a convenience multiple pairs of keywords and variables may be</span>
<a name="ln-2633"></a><span class="c">!!    specified if and only if all the values are scalars and the CHARACTER</span>
<a name="ln-2634"></a><span class="c">!!    variables are fixed-length or pre-allocated.</span>
<a name="ln-2635"></a><span class="c">!!</span>
<a name="ln-2636"></a><span class="c">!!##OPTIONS</span>
<a name="ln-2637"></a><span class="c">!!</span>
<a name="ln-2638"></a><span class="c">!!     NAME        name of commandline argument to obtain the value of</span>
<a name="ln-2639"></a><span class="c">!!     VALUE       variable to hold returned value. The kind of the value</span>
<a name="ln-2640"></a><span class="c">!!                 is used to determine the type of returned value. May</span>
<a name="ln-2641"></a><span class="c">!!                 be a scalar or allocatable array. If type is CHARACTER</span>
<a name="ln-2642"></a><span class="c">!!                 the scalar must have an allocatable length.</span>
<a name="ln-2643"></a><span class="c">!!     DELIMITERS  By default the delimiter for array values are comma,</span>
<a name="ln-2644"></a><span class="c">!!                 colon, and whitespace. A string containing an alternate</span>
<a name="ln-2645"></a><span class="c">!!                 list of delimiter characters may be supplied.</span>
<a name="ln-2646"></a><span class="c">!!</span>
<a name="ln-2647"></a><span class="c">!!##CONVENIENCE FUNCTIONS</span>
<a name="ln-2648"></a><span class="c">!!</span>
<a name="ln-2649"></a><span class="c">!!    There are convenience functions that are replacements for calls to</span>
<a name="ln-2650"></a><span class="c">!!    get_args(3f) for each supported default intrinsic type</span>
<a name="ln-2651"></a><span class="c">!!</span>
<a name="ln-2652"></a><span class="c">!!      o scalars -- dget(3f), iget(3f), lget(3f), rget(3f), sget(3f),</span>
<a name="ln-2653"></a><span class="c">!!                   cget(3f)</span>
<a name="ln-2654"></a><span class="c">!!      o vectors -- dgets(3f), igets(3f), lgets(3f), rgets(3f),</span>
<a name="ln-2655"></a><span class="c">!!                   sgets(3f), cgets(3f)</span>
<a name="ln-2656"></a><span class="c">!!</span>
<a name="ln-2657"></a><span class="c">!!    D is for DOUBLEPRECISION, I for INTEGER, L for LOGICAL, R for REAL,</span>
<a name="ln-2658"></a><span class="c">!!    S for string (CHARACTER), and C for COMPLEX.</span>
<a name="ln-2659"></a><span class="c">!!</span>
<a name="ln-2660"></a><span class="c">!!    If the functions are called with no argument they will return the</span>
<a name="ln-2661"></a><span class="c">!!    UNNAMED array converted to the specified type.</span>
<a name="ln-2662"></a><span class="c">!!</span>
<a name="ln-2663"></a><span class="c">!!##EXAMPLE</span>
<a name="ln-2664"></a><span class="c">!!</span>
<a name="ln-2665"></a><span class="c">!!</span>
<a name="ln-2666"></a><span class="c">!! Sample program:</span>
<a name="ln-2667"></a><span class="c">!!</span>
<a name="ln-2668"></a><span class="c">!!     program demo_get_args</span>
<a name="ln-2669"></a><span class="c">!!     use M_CLI2,  only : filenames=&gt;unnamed, set_args, get_args</span>
<a name="ln-2670"></a><span class="c">!!     implicit none</span>
<a name="ln-2671"></a><span class="c">!!     integer                      :: i</span>
<a name="ln-2672"></a><span class="c">!!     ! DEFINE ARGS</span>
<a name="ln-2673"></a><span class="c">!!     real                         :: x, y, z</span>
<a name="ln-2674"></a><span class="c">!!     real,allocatable             :: p(:)</span>
<a name="ln-2675"></a><span class="c">!!     character(len=:),allocatable :: title</span>
<a name="ln-2676"></a><span class="c">!!     logical                      :: l, lbig</span>
<a name="ln-2677"></a><span class="c">!!     ! DEFINE AND PARSE (TO SET INITIAL VALUES) COMMAND LINE</span>
<a name="ln-2678"></a><span class="c">!!     !   o only quote strings and use double-quotes</span>
<a name="ln-2679"></a><span class="c">!!     !   o set all logical values to F or T.</span>
<a name="ln-2680"></a><span class="c">!!     call set_args(&#39; &amp;</span>
<a name="ln-2681"></a><span class="c">!!        &amp;-x 1 -y 2 -z 3 &amp;</span>
<a name="ln-2682"></a><span class="c">!!        &amp;-p -1,-2,-3 &amp;</span>
<a name="ln-2683"></a><span class="c">!!        &amp;--title &quot;my title&quot; &amp;</span>
<a name="ln-2684"></a><span class="c">!!        &amp; -l F -L F  &amp;</span>
<a name="ln-2685"></a><span class="c">!!        &amp; --label &quot; &quot; &amp;</span>
<a name="ln-2686"></a><span class="c">!!        &amp; &#39;)</span>
<a name="ln-2687"></a><span class="c">!!     ! ASSIGN VALUES TO ELEMENTS</span>
<a name="ln-2688"></a><span class="c">!!     ! SCALARS</span>
<a name="ln-2689"></a><span class="c">!!     call get_args(&#39;x&#39;,x,&#39;y&#39;,y,&#39;z&#39;,z)</span>
<a name="ln-2690"></a><span class="c">!!     call get_args(&#39;l&#39;,l)</span>
<a name="ln-2691"></a><span class="c">!!     call get_args(&#39;L&#39;,lbig)</span>
<a name="ln-2692"></a><span class="c">!!     ! ALLOCATABLE STRING</span>
<a name="ln-2693"></a><span class="c">!!     call get_args(&#39;title&#39;,title)</span>
<a name="ln-2694"></a><span class="c">!!     ! NON-ALLOCATABLE ARRAYS</span>
<a name="ln-2695"></a><span class="c">!!     call get_args(&#39;p&#39;,p)</span>
<a name="ln-2696"></a><span class="c">!!     ! USE VALUES</span>
<a name="ln-2697"></a><span class="c">!!     write(*,&#39;(1x,g0,&quot;=&quot;,g0)&#39;)&#39;x&#39;,x, &#39;y&#39;,y, &#39;z&#39;,z</span>
<a name="ln-2698"></a><span class="c">!!     write(*,*)&#39;p=&#39;,p</span>
<a name="ln-2699"></a><span class="c">!!     write(*,*)&#39;title=&#39;,title</span>
<a name="ln-2700"></a><span class="c">!!     write(*,*)&#39;l=&#39;,l</span>
<a name="ln-2701"></a><span class="c">!!     write(*,*)&#39;L=&#39;,lbig</span>
<a name="ln-2702"></a><span class="c">!!     if(size(filenames).gt.0)then</span>
<a name="ln-2703"></a><span class="c">!!        write(*,&#39;(i6.6,3a)&#39;)(i,&#39;[&#39;,filenames(i),&#39;]&#39;,i=1,size(filenames))</span>
<a name="ln-2704"></a><span class="c">!!     endif</span>
<a name="ln-2705"></a><span class="c">!!     end program demo_get_args</span>
<a name="ln-2706"></a><span class="c">!!##AUTHOR</span>
<a name="ln-2707"></a><span class="c">!!      John S. Urban, 2019</span>
<a name="ln-2708"></a><span class="c">!!##LICENSE</span>
<a name="ln-2709"></a><span class="c">!!      Public Domain</span>
<a name="ln-2710"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-2711"></a><span class="c">!&gt;</span>
<a name="ln-2712"></a><span class="c">!!##NAME</span>
<a name="ln-2713"></a><span class="c">!!    get_args_fixed_length(3f) - [ARGUMENTS:M_CLI2] return keyword values</span>
<a name="ln-2714"></a><span class="c">!!    for fixed-length string when parsing command line</span>
<a name="ln-2715"></a><span class="c">!!    (LICENSE:PD)</span>
<a name="ln-2716"></a><span class="c">!!</span>
<a name="ln-2717"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-2718"></a><span class="c">!!</span>
<a name="ln-2719"></a><span class="c">!!    subroutine get_args_fixed_length(name,value)</span>
<a name="ln-2720"></a><span class="c">!!</span>
<a name="ln-2721"></a><span class="c">!!     character(len=:),allocatable :: value</span>
<a name="ln-2722"></a><span class="c">!!     character(len=*),intent(in),optional :: delimiters</span>
<a name="ln-2723"></a><span class="c">!!</span>
<a name="ln-2724"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-2725"></a><span class="c">!!</span>
<a name="ln-2726"></a><span class="c">!!    GET_ARGS_fixed_length(3f) returns the value of a string</span>
<a name="ln-2727"></a><span class="c">!!    keyword when the string value is a fixed-length CHARACTER</span>
<a name="ln-2728"></a><span class="c">!!    variable.</span>
<a name="ln-2729"></a><span class="c">!!</span>
<a name="ln-2730"></a><span class="c">!!##OPTIONS</span>
<a name="ln-2731"></a><span class="c">!!</span>
<a name="ln-2732"></a><span class="c">!!    NAME   name of commandline argument to obtain the value of</span>
<a name="ln-2733"></a><span class="c">!!</span>
<a name="ln-2734"></a><span class="c">!!    VALUE  variable to hold returned value.</span>
<a name="ln-2735"></a><span class="c">!!           Must be a fixed-length CHARACTER variable.</span>
<a name="ln-2736"></a><span class="c">!!</span>
<a name="ln-2737"></a><span class="c">!!    DELIMITERS  By default the delimiter for array values are comma,</span>
<a name="ln-2738"></a><span class="c">!!                colon, and whitespace. A string containing an alternate</span>
<a name="ln-2739"></a><span class="c">!!                list of delimiter characters may be supplied.</span>
<a name="ln-2740"></a><span class="c">!!</span>
<a name="ln-2741"></a><span class="c">!!##EXAMPLE</span>
<a name="ln-2742"></a><span class="c">!!</span>
<a name="ln-2743"></a><span class="c">!! Sample program:</span>
<a name="ln-2744"></a><span class="c">!!</span>
<a name="ln-2745"></a><span class="c">!!     program demo_get_args_fixed_length</span>
<a name="ln-2746"></a><span class="c">!!     use M_CLI2,  only : set_args, get_args_fixed_length</span>
<a name="ln-2747"></a><span class="c">!!     implicit none</span>
<a name="ln-2748"></a><span class="c">!!     ! DEFINE ARGS</span>
<a name="ln-2749"></a><span class="c">!!     character(len=80)   :: title</span>
<a name="ln-2750"></a><span class="c">!!     call set_args(&#39; &amp;</span>
<a name="ln-2751"></a><span class="c">!!        &amp; -title &quot;my title&quot; &amp;</span>
<a name="ln-2752"></a><span class="c">!!        &amp; &#39;)</span>
<a name="ln-2753"></a><span class="c">!!     ! ASSIGN VALUES TO ELEMENTS</span>
<a name="ln-2754"></a><span class="c">!!        call get_args_fixed_length(&#39;title&#39;,title)</span>
<a name="ln-2755"></a><span class="c">!!     ! USE VALUES</span>
<a name="ln-2756"></a><span class="c">!!        write(*,*)&#39;title=&#39;,title</span>
<a name="ln-2757"></a><span class="c">!!     end program demo_get_args_fixed_length</span>
<a name="ln-2758"></a><span class="c">!!</span>
<a name="ln-2759"></a><span class="c">!!##AUTHOR</span>
<a name="ln-2760"></a><span class="c">!!      John S. Urban, 2019</span>
<a name="ln-2761"></a><span class="c">!!##LICENSE</span>
<a name="ln-2762"></a><span class="c">!!      Public Domain</span>
<a name="ln-2763"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-2764"></a><span class="c">!&gt;</span>
<a name="ln-2765"></a><span class="c">!!##NAME</span>
<a name="ln-2766"></a><span class="c">!!    get_args_fixed_size(3f) - [ARGUMENTS:M_CLI2] return keyword values</span>
<a name="ln-2767"></a><span class="c">!!    for fixed-size array when parsing command line arguments</span>
<a name="ln-2768"></a><span class="c">!!    (LICENSE:PD)</span>
<a name="ln-2769"></a><span class="c">!!</span>
<a name="ln-2770"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-2771"></a><span class="c">!!</span>
<a name="ln-2772"></a><span class="c">!!    subroutine get_args_fixed_size(name,value)</span>
<a name="ln-2773"></a><span class="c">!!</span>
<a name="ln-2774"></a><span class="c">!!     [real|doubleprecision|integer|logical|complex] :: value(NNN)</span>
<a name="ln-2775"></a><span class="c">!!        or</span>
<a name="ln-2776"></a><span class="c">!!     character(len=MMM) :: value(NNN)</span>
<a name="ln-2777"></a><span class="c">!!</span>
<a name="ln-2778"></a><span class="c">!!     character(len=*),intent(in),optional :: delimiters</span>
<a name="ln-2779"></a><span class="c">!!</span>
<a name="ln-2780"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-2781"></a><span class="c">!!</span>
<a name="ln-2782"></a><span class="c">!!    GET_ARGS_FIXED_SIZE(3f) returns the value of keywords for</span>
<a name="ln-2783"></a><span class="c">!!    fixed-size arrays after SET_ARGS(3f) has been called.</span>
<a name="ln-2784"></a><span class="c">!!    On input on the command line all values of the array must</span>
<a name="ln-2785"></a><span class="c">!!    be specified.</span>
<a name="ln-2786"></a><span class="c">!!</span>
<a name="ln-2787"></a><span class="c">!!##OPTIONS</span>
<a name="ln-2788"></a><span class="c">!!    NAME        name of commandline argument to obtain the value of</span>
<a name="ln-2789"></a><span class="c">!!</span>
<a name="ln-2790"></a><span class="c">!!    VALUE       variable to hold returned values. The kind of the value</span>
<a name="ln-2791"></a><span class="c">!!                is used to determine the type of returned value. Must be</span>
<a name="ln-2792"></a><span class="c">!!                a fixed-size array. If type is CHARACTER the length must</span>
<a name="ln-2793"></a><span class="c">!!                also be fixed.</span>
<a name="ln-2794"></a><span class="c">!!</span>
<a name="ln-2795"></a><span class="c">!!    DELIMITERS  By default the delimiter for array values are comma,</span>
<a name="ln-2796"></a><span class="c">!!                colon, and whitespace. A string containing an alternate</span>
<a name="ln-2797"></a><span class="c">!!                list of delimiter characters may be supplied.</span>
<a name="ln-2798"></a><span class="c">!!</span>
<a name="ln-2799"></a><span class="c">!!##EXAMPLE</span>
<a name="ln-2800"></a><span class="c">!!</span>
<a name="ln-2801"></a><span class="c">!! Sample program:</span>
<a name="ln-2802"></a><span class="c">!!</span>
<a name="ln-2803"></a><span class="c">!!     program demo_get_args_fixed_size</span>
<a name="ln-2804"></a><span class="c">!!     use M_CLI2,  only : set_args, get_args_fixed_size</span>
<a name="ln-2805"></a><span class="c">!!     implicit none</span>
<a name="ln-2806"></a><span class="c">!!     integer,parameter   :: dp=kind(0.0d0)</span>
<a name="ln-2807"></a><span class="c">!!     ! DEFINE ARGS</span>
<a name="ln-2808"></a><span class="c">!!     real                :: x(2)</span>
<a name="ln-2809"></a><span class="c">!!     real(kind=dp)       :: y(2)</span>
<a name="ln-2810"></a><span class="c">!!     integer             :: p(3)</span>
<a name="ln-2811"></a><span class="c">!!     character(len=80)   :: title(1)</span>
<a name="ln-2812"></a><span class="c">!!     logical             :: l(4), lbig(4)</span>
<a name="ln-2813"></a><span class="c">!!     complex             :: cmp(2)</span>
<a name="ln-2814"></a><span class="c">!!     ! DEFINE AND PARSE (TO SET INITIAL VALUES) COMMAND LINE</span>
<a name="ln-2815"></a><span class="c">!!     !   o only quote strings</span>
<a name="ln-2816"></a><span class="c">!!     !   o set all logical values to F or T.</span>
<a name="ln-2817"></a><span class="c">!!     call set_args(&#39; &amp;</span>
<a name="ln-2818"></a><span class="c">!!        &amp; -x 10.0,20.0 &amp;</span>
<a name="ln-2819"></a><span class="c">!!        &amp; -y 11.0,22.0 &amp;</span>
<a name="ln-2820"></a><span class="c">!!        &amp; -p -1,-2,-3 &amp;</span>
<a name="ln-2821"></a><span class="c">!!        &amp; -title &quot;my title&quot; &amp;</span>
<a name="ln-2822"></a><span class="c">!!        &amp; -l F,T,F,T -L T,F,T,F  &amp;</span>
<a name="ln-2823"></a><span class="c">!!        &amp; --cmp 111,222.0,333.0e0,4444 &amp;</span>
<a name="ln-2824"></a><span class="c">!!        &amp; &#39;)</span>
<a name="ln-2825"></a><span class="c">!!     ! ASSIGN VALUES TO ELEMENTS</span>
<a name="ln-2826"></a><span class="c">!!        call get_args_fixed_size(&#39;x&#39;,x)</span>
<a name="ln-2827"></a><span class="c">!!        call get_args_fixed_size(&#39;y&#39;,y)</span>
<a name="ln-2828"></a><span class="c">!!        call get_args_fixed_size(&#39;p&#39;,p)</span>
<a name="ln-2829"></a><span class="c">!!        call get_args_fixed_size(&#39;title&#39;,title)</span>
<a name="ln-2830"></a><span class="c">!!        call get_args_fixed_size(&#39;l&#39;,l)</span>
<a name="ln-2831"></a><span class="c">!!        call get_args_fixed_size(&#39;L&#39;,lbig)</span>
<a name="ln-2832"></a><span class="c">!!        call get_args_fixed_size(&#39;cmp&#39;,cmp)</span>
<a name="ln-2833"></a><span class="c">!!     ! USE VALUES</span>
<a name="ln-2834"></a><span class="c">!!        write(*,*)&#39;x=&#39;,x</span>
<a name="ln-2835"></a><span class="c">!!        write(*,*)&#39;p=&#39;,p</span>
<a name="ln-2836"></a><span class="c">!!        write(*,*)&#39;title=&#39;,title</span>
<a name="ln-2837"></a><span class="c">!!        write(*,*)&#39;l=&#39;,l</span>
<a name="ln-2838"></a><span class="c">!!        write(*,*)&#39;L=&#39;,lbig</span>
<a name="ln-2839"></a><span class="c">!!        write(*,*)&#39;cmp=&#39;,cmp</span>
<a name="ln-2840"></a><span class="c">!!     end program demo_get_args_fixed_size</span>
<a name="ln-2841"></a><span class="c">!!   Results:</span>
<a name="ln-2842"></a><span class="c">!!</span>
<a name="ln-2843"></a><span class="c">!!##AUTHOR</span>
<a name="ln-2844"></a><span class="c">!!      John S. Urban, 2019</span>
<a name="ln-2845"></a><span class="c">!!##LICENSE</span>
<a name="ln-2846"></a><span class="c">!!      Public Domain</span>
<a name="ln-2847"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-2848"></a><span class="k">subroutine </span><span class="n">get_fixedarray_class</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="k">generic</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-2849"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">keyword</span>      <span class="c">! keyword to retrieve value from dictionary</span>
<a name="ln-2850"></a><span class="k">class</span><span class="p">(</span><span class="o">*</span><span class="p">)</span>                             <span class="kd">::</span> <span class="k">generic</span><span class="p">(:)</span>
<a name="ln-2851"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">delimiters</span>
<a name="ln-2852"></a>   <span class="k">select type</span><span class="p">(</span><span class="k">generic</span><span class="p">)</span>
<a name="ln-2853"></a>    <span class="k">type is</span> <span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">));</span>  <span class="k">call </span><span class="n">get_fixedarray_fixed_length_c</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="k">generic</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-2854"></a>    <span class="k">type is</span> <span class="p">(</span><span class="kt">integer</span><span class="p">);</span>           <span class="k">call </span><span class="n">get_fixedarray_i</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="k">generic</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-2855"></a>    <span class="k">type is</span> <span class="p">(</span><span class="kt">real</span><span class="p">);</span>              <span class="k">call </span><span class="n">get_fixedarray_r</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="k">generic</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-2856"></a>    <span class="k">type is</span> <span class="p">(</span><span class="kt">complex</span><span class="p">);</span>           <span class="k">call </span><span class="n">get_fixed_size_complex</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="k">generic</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-2857"></a>    <span class="k">type is</span> <span class="p">(</span><span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">dp</span><span class="p">));</span>     <span class="k">call </span><span class="n">get_fixedarray_d</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="k">generic</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-2858"></a>    <span class="k">type is</span> <span class="p">(</span><span class="kt">logical</span><span class="p">);</span>           <span class="k">call </span><span class="n">get_fixedarray_l</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="k">generic</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-2859"></a>    <span class="k">class </span><span class="n">default</span>
<a name="ln-2860"></a>      <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="o">-</span><span class="mi">7</span><span class="p">,</span><span class="s1">&#39;*get_fixedarray_class* crud -- procedure does not know about this type&#39;</span><span class="p">)</span>
<a name="ln-2861"></a>   <span class="k">end select</span>
<a name="ln-2862"></a><span class="k">end subroutine </span><span class="n">get_fixedarray_class</span>
<a name="ln-2863"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-2864"></a><span class="c">! return allocatable arrays</span>
<a name="ln-2865"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-2866"></a><span class="k">subroutine </span><span class="n">get_anyarray_l</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">larray</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-2867"></a>
<a name="ln-2868"></a><span class="c">! ident_7=&quot;@(#)M_CLI2::get_anyarray_l(3f): given keyword fetch logical array from string in dictionary(F on err)&quot;</span>
<a name="ln-2869"></a>
<a name="ln-2870"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>  <span class="kd">::</span> <span class="n">keyword</span>                    <span class="c">! the dictionary keyword (in form VERB_KEYWORD) to retrieve</span>
<a name="ln-2871"></a><span class="kt">logical</span><span class="p">,</span><span class="k">allocatable</span>          <span class="kd">::</span> <span class="n">larray</span><span class="p">(:)</span>                  <span class="c">! convert value to an array</span>
<a name="ln-2872"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>   <span class="kd">::</span> <span class="n">delimiters</span>
<a name="ln-2873"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">carray</span><span class="p">(:)</span>                  <span class="c">! convert value to an array</span>
<a name="ln-2874"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">val</span>
<a name="ln-2875"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">i</span>
<a name="ln-2876"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">place</span>
<a name="ln-2877"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">iichar</span>                     <span class="c">! point to first character of word unless first character is &quot;.&quot;</span>
<a name="ln-2878"></a>   <span class="k">call </span><span class="n">locate_key</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>                          <span class="c">! find where string is or should be</span>
<a name="ln-2879"></a>   <span class="k">if</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                      <span class="c">! if string was found</span>
<a name="ln-2880"></a>      <span class="n">val</span><span class="o">=</span><span class="n">values</span><span class="p">(</span><span class="n">place</span><span class="p">)(:</span><span class="n">counts</span><span class="p">(</span><span class="n">place</span><span class="p">))</span>
<a name="ln-2881"></a>      <span class="k">call </span><span class="n">split</span><span class="p">(</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">upper</span><span class="p">(</span><span class="n">val</span><span class="p">)),</span><span class="n">carray</span><span class="p">,</span><span class="n">delimiters</span><span class="o">=</span><span class="n">delimiters</span><span class="p">)</span>  <span class="c">! convert value to uppercase, trimmed; then parse into array</span>
<a name="ln-2882"></a>   <span class="k">else</span>
<a name="ln-2883"></a><span class="k">      call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*get_anyarray_l* unknown keyword &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-2884"></a>      <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">8</span> <span class="p">,</span><span class="s1">&#39;*get_anyarray_l* unknown keyword &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-2885"></a>      <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">larray</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">larray</span><span class="p">)</span>
<a name="ln-2886"></a>      <span class="k">allocate</span><span class="p">(</span><span class="n">larray</span><span class="p">(</span><span class="mi">0</span><span class="p">))</span>
<a name="ln-2887"></a>      <span class="k">return</span>
<a name="ln-2888"></a><span class="k">   endif</span>
<a name="ln-2889"></a><span class="k">   if</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">carray</span><span class="p">).</span><span class="n">gt</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                  <span class="c">! if not a null string</span>
<a name="ln-2890"></a>      <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">larray</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">larray</span><span class="p">)</span>
<a name="ln-2891"></a>      <span class="k">allocate</span><span class="p">(</span><span class="n">larray</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">carray</span><span class="p">)))</span>                          <span class="c">! allocate output array</span>
<a name="ln-2892"></a>      <span class="k">do </span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">carray</span><span class="p">)</span>
<a name="ln-2893"></a>         <span class="n">larray</span><span class="p">(</span><span class="n">i</span><span class="p">)</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>                                    <span class="c">! initialize return value to .false.</span>
<a name="ln-2894"></a>         <span class="k">if</span><span class="p">(</span><span class="n">carray</span><span class="p">(</span><span class="n">i</span><span class="p">)(</span><span class="mi">1</span><span class="p">:</span><span class="mi">1</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="s1">&#39;.&#39;</span><span class="p">)</span><span class="k">then</span>                        <span class="c">! looking for fortran logical syntax .STRING.</span>
<a name="ln-2895"></a>            <span class="n">iichar</span><span class="o">=</span><span class="mi">2</span>
<a name="ln-2896"></a>         <span class="k">else</span>
<a name="ln-2897"></a><span class="k">            </span><span class="n">iichar</span><span class="o">=</span><span class="mi">1</span>
<a name="ln-2898"></a>         <span class="k">endif</span>
<a name="ln-2899"></a><span class="k">         select case</span><span class="p">(</span><span class="n">carray</span><span class="p">(</span><span class="n">i</span><span class="p">)(</span><span class="n">iichar</span><span class="p">:</span><span class="n">iichar</span><span class="p">))</span>             <span class="c">! check word to see if true or false</span>
<a name="ln-2900"></a>         <span class="k">case</span><span class="p">(</span><span class="s1">&#39;T&#39;</span><span class="p">,</span><span class="s1">&#39;Y&#39;</span><span class="p">,</span><span class="s1">&#39; &#39;</span><span class="p">);</span> <span class="n">larray</span><span class="p">(</span><span class="n">i</span><span class="p">)</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.</span>               <span class="c">! anything starting with &quot;T&quot; or &quot;Y&quot; or a blank is TRUE (true,yes,...)</span>
<a name="ln-2901"></a>         <span class="k">case</span><span class="p">(</span><span class="s1">&#39;F&#39;</span><span class="p">,</span><span class="s1">&#39;N&#39;</span><span class="p">);</span>     <span class="n">larray</span><span class="p">(</span><span class="n">i</span><span class="p">)</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>              <span class="c">! assume this is false or no</span>
<a name="ln-2902"></a>         <span class="k">case </span><span class="n">default</span>
<a name="ln-2903"></a>            <span class="k">call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s2">&quot;*get_anyarray_l* bad logical expression for &quot;</span><span class="o">//</span><span class="nb">trim</span><span class="p">(</span><span class="n">keyword</span><span class="p">)</span><span class="o">//</span><span class="s1">&#39;=&#39;</span><span class="o">//</span><span class="n">carray</span><span class="p">(</span><span class="n">i</span><span class="p">))</span>
<a name="ln-2904"></a>         <span class="k">end select</span>
<a name="ln-2905"></a><span class="k">      enddo</span>
<a name="ln-2906"></a><span class="k">   else</span>                                                       <span class="c">! for a blank string return one T</span>
<a name="ln-2907"></a>      <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">larray</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">larray</span><span class="p">)</span>
<a name="ln-2908"></a>      <span class="k">allocate</span><span class="p">(</span><span class="n">larray</span><span class="p">(</span><span class="mi">1</span><span class="p">))</span>                                     <span class="c">! allocate output array</span>
<a name="ln-2909"></a>      <span class="n">larray</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.</span>
<a name="ln-2910"></a>   <span class="k">endif</span>
<a name="ln-2911"></a><span class="k">end subroutine </span><span class="n">get_anyarray_l</span>
<a name="ln-2912"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-2913"></a><span class="k">subroutine </span><span class="n">get_anyarray_d</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">darray</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-2914"></a>
<a name="ln-2915"></a><span class="c">! ident_8=&quot;@(#)M_CLI2::get_anyarray_d(3f): given keyword fetch dble value array from Language Dictionary (0 on err)&quot;</span>
<a name="ln-2916"></a>
<a name="ln-2917"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>           <span class="kd">::</span> <span class="n">keyword</span>      <span class="c">! keyword to retrieve value from dictionary</span>
<a name="ln-2918"></a><span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">dp</span><span class="p">),</span><span class="k">allocatable</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span> <span class="kd">::</span> <span class="n">darray</span><span class="p">(:)</span>    <span class="c">! function type</span>
<a name="ln-2919"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>  <span class="kd">::</span> <span class="n">delimiters</span>
<a name="ln-2920"></a>
<a name="ln-2921"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>          <span class="kd">::</span> <span class="n">carray</span><span class="p">(:)</span>    <span class="c">! convert value to an array using split(3f)</span>
<a name="ln-2922"></a><span class="kt">integer</span>                               <span class="kd">::</span> <span class="n">i</span>
<a name="ln-2923"></a><span class="kt">integer</span>                               <span class="kd">::</span> <span class="n">place</span>
<a name="ln-2924"></a><span class="kt">integer</span>                               <span class="kd">::</span> <span class="n">ierr</span>
<a name="ln-2925"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>          <span class="kd">::</span> <span class="n">val</span>
<a name="ln-2926"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-2927"></a>   <span class="k">call </span><span class="n">locate_key</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>                     <span class="c">! find where string is or should be</span>
<a name="ln-2928"></a>   <span class="k">if</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                 <span class="c">! if string was found</span>
<a name="ln-2929"></a>      <span class="n">val</span><span class="o">=</span><span class="n">values</span><span class="p">(</span><span class="n">place</span><span class="p">)(:</span><span class="n">counts</span><span class="p">(</span><span class="n">place</span><span class="p">))</span>
<a name="ln-2930"></a>      <span class="n">val</span><span class="o">=</span><span class="n">replace_str</span><span class="p">(</span><span class="n">val</span><span class="p">,</span><span class="s1">&#39;(&#39;</span><span class="p">,</span><span class="s1">&#39;&#39;</span><span class="p">)</span>
<a name="ln-2931"></a>      <span class="n">val</span><span class="o">=</span><span class="n">replace_str</span><span class="p">(</span><span class="n">val</span><span class="p">,</span><span class="s1">&#39;)&#39;</span><span class="p">,</span><span class="s1">&#39;&#39;</span><span class="p">)</span>
<a name="ln-2932"></a>      <span class="k">call </span><span class="n">split</span><span class="p">(</span><span class="n">val</span><span class="p">,</span><span class="n">carray</span><span class="p">,</span><span class="n">delimiters</span><span class="o">=</span><span class="n">delimiters</span><span class="p">)</span>    <span class="c">! find value associated with keyword and split it into an array</span>
<a name="ln-2933"></a>   <span class="k">else</span>
<a name="ln-2934"></a><span class="k">      call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*get_anyarray_d* unknown keyword &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-2935"></a>      <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">9</span> <span class="p">,</span><span class="s1">&#39;*get_anyarray_d* unknown keyword &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-2936"></a>      <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">darray</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">darray</span><span class="p">)</span>
<a name="ln-2937"></a>      <span class="k">allocate</span><span class="p">(</span><span class="n">darray</span><span class="p">(</span><span class="mi">0</span><span class="p">))</span>
<a name="ln-2938"></a>      <span class="k">return</span>
<a name="ln-2939"></a><span class="k">   endif</span>
<a name="ln-2940"></a><span class="k">   if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">darray</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">darray</span><span class="p">)</span>
<a name="ln-2941"></a>   <span class="k">allocate</span><span class="p">(</span><span class="n">darray</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">carray</span><span class="p">)))</span>                     <span class="c">! create the output array</span>
<a name="ln-2942"></a>   <span class="k">do </span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">carray</span><span class="p">)</span>
<a name="ln-2943"></a>      <span class="k">call </span><span class="n">a2d</span><span class="p">(</span><span class="n">carray</span><span class="p">(</span><span class="n">i</span><span class="p">),</span> <span class="n">darray</span><span class="p">(</span><span class="n">i</span><span class="p">),</span><span class="n">ierr</span><span class="p">)</span> <span class="c">! convert the string to a numeric value</span>
<a name="ln-2944"></a>      <span class="k">if</span><span class="p">(</span><span class="n">ierr</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-2945"></a><span class="k">         call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">10</span> <span class="p">,</span><span class="s1">&#39;*get_anyarray_d* unreadable value &#39;</span><span class="o">//</span><span class="n">carray</span><span class="p">(</span><span class="n">i</span><span class="p">)</span><span class="o">//</span><span class="s1">&#39; for keyword &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-2946"></a>      <span class="k">endif</span>
<a name="ln-2947"></a><span class="k">   enddo</span>
<a name="ln-2948"></a><span class="k">end subroutine </span><span class="n">get_anyarray_d</span>
<a name="ln-2949"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-2950"></a><span class="k">subroutine </span><span class="n">get_anyarray_i</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">iarray</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-2951"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">keyword</span>      <span class="c">! keyword to retrieve value from dictionary</span>
<a name="ln-2952"></a><span class="kt">integer</span><span class="p">,</span><span class="k">allocatable</span>                  <span class="kd">::</span> <span class="n">iarray</span><span class="p">(:)</span>
<a name="ln-2953"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">delimiters</span>
<a name="ln-2954"></a><span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">dp</span><span class="p">),</span><span class="k">allocatable</span>            <span class="kd">::</span> <span class="n">darray</span><span class="p">(:)</span>    <span class="c">! function type</span>
<a name="ln-2955"></a>   <span class="k">call </span><span class="n">get_anyarray_d</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">darray</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-2956"></a>   <span class="n">iarray</span><span class="o">=</span><span class="nb">nint</span><span class="p">(</span><span class="n">darray</span><span class="p">)</span>
<a name="ln-2957"></a><span class="k">end subroutine </span><span class="n">get_anyarray_i</span>
<a name="ln-2958"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-2959"></a><span class="k">subroutine </span><span class="n">get_anyarray_r</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">rarray</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-2960"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">keyword</span>      <span class="c">! keyword to retrieve value from dictionary</span>
<a name="ln-2961"></a><span class="kt">real</span><span class="p">,</span><span class="k">allocatable</span>                     <span class="kd">::</span> <span class="n">rarray</span><span class="p">(:)</span>
<a name="ln-2962"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">delimiters</span>
<a name="ln-2963"></a><span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">dp</span><span class="p">),</span><span class="k">allocatable</span>            <span class="kd">::</span> <span class="n">darray</span><span class="p">(:)</span>    <span class="c">! function type</span>
<a name="ln-2964"></a>   <span class="k">call </span><span class="n">get_anyarray_d</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">darray</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-2965"></a>   <span class="n">rarray</span><span class="o">=</span><span class="kt">real</span><span class="p">(</span><span class="n">darray</span><span class="p">)</span>
<a name="ln-2966"></a><span class="k">end subroutine </span><span class="n">get_anyarray_r</span>
<a name="ln-2967"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-2968"></a><span class="k">subroutine </span><span class="n">get_anyarray_x</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">xarray</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-2969"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">keyword</span>      <span class="c">! keyword to retrieve value from dictionary</span>
<a name="ln-2970"></a><span class="kt">complex</span><span class="p">,</span><span class="k">allocatable</span>                  <span class="kd">::</span> <span class="n">xarray</span><span class="p">(:)</span>
<a name="ln-2971"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">delimiters</span>
<a name="ln-2972"></a><span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">dp</span><span class="p">),</span><span class="k">allocatable</span>            <span class="kd">::</span> <span class="n">darray</span><span class="p">(:)</span>    <span class="c">! function type</span>
<a name="ln-2973"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">half</span><span class="p">,</span><span class="n">sz</span><span class="p">,</span><span class="n">i</span>
<a name="ln-2974"></a>   <span class="k">call </span><span class="n">get_anyarray_d</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">darray</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-2975"></a>   <span class="n">sz</span><span class="o">=</span><span class="n">size</span><span class="p">(</span><span class="n">darray</span><span class="p">)</span>
<a name="ln-2976"></a>   <span class="n">half</span><span class="o">=</span><span class="n">sz</span><span class="o">/</span><span class="mi">2</span>
<a name="ln-2977"></a>   <span class="k">if</span><span class="p">(</span><span class="n">sz</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="n">half</span><span class="o">+</span><span class="n">half</span><span class="p">)</span><span class="k">then</span>
<a name="ln-2978"></a><span class="k">      call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*get_anyarray_x* uneven number of values defining complex value &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-2979"></a>      <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">11</span><span class="p">,</span><span class="s1">&#39;*get_anyarray_x* uneven number of values defining complex value &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-2980"></a>      <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">xarray</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">xarray</span><span class="p">)</span>
<a name="ln-2981"></a>      <span class="k">allocate</span><span class="p">(</span><span class="n">xarray</span><span class="p">(</span><span class="mi">0</span><span class="p">))</span>
<a name="ln-2982"></a>   <span class="k">endif</span>
<a name="ln-2983"></a>
<a name="ln-2984"></a>   <span class="c">!x!================================================================================================</span>
<a name="ln-2985"></a>   <span class="c">!x!IFORT,GFORTRAN OK, NVIDIA RETURNS NULL ARRAY: xarray=cmplx(real(darray(1::2)),real(darray(2::2)))</span>
<a name="ln-2986"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">xarray</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">xarray</span><span class="p">)</span>
<a name="ln-2987"></a>   <span class="k">allocate</span><span class="p">(</span><span class="n">xarray</span><span class="p">(</span><span class="n">half</span><span class="p">))</span>
<a name="ln-2988"></a>   <span class="k">do </span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">sz</span><span class="p">,</span><span class="mi">2</span>
<a name="ln-2989"></a>      <span class="n">xarray</span><span class="p">((</span><span class="n">i</span><span class="o">+</span><span class="mi">1</span><span class="p">)</span><span class="o">/</span><span class="mi">2</span><span class="p">)</span><span class="o">=</span><span class="nb">cmplx</span><span class="p">(</span> <span class="n">darray</span><span class="p">(</span><span class="n">i</span><span class="p">),</span><span class="n">darray</span><span class="p">(</span><span class="n">i</span><span class="o">+</span><span class="mi">1</span><span class="p">)</span> <span class="p">)</span>
<a name="ln-2990"></a>   <span class="k">enddo</span>
<a name="ln-2991"></a>   <span class="c">!x!================================================================================================</span>
<a name="ln-2992"></a>
<a name="ln-2993"></a><span class="k">end subroutine </span><span class="n">get_anyarray_x</span>
<a name="ln-2994"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-2995"></a><span class="k">subroutine </span><span class="n">get_anyarray_c</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">strings</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-2996"></a>
<a name="ln-2997"></a><span class="c">! ident_8=&quot;@(#)M_CLI2::get_anyarray_c(3f): Fetch strings value for specified KEYWORD from the lang. dictionary&quot;</span>
<a name="ln-2998"></a>
<a name="ln-2999"></a><span class="c">! This routine trusts that the desired keyword exists. A blank is returned if the keyword is not in the dictionary</span>
<a name="ln-3000"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">keyword</span>       <span class="c">! name to look up in dictionary</span>
<a name="ln-3001"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>         <span class="kd">::</span> <span class="n">strings</span><span class="p">(:)</span>
<a name="ln-3002"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">delimiters</span>
<a name="ln-3003"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">place</span>
<a name="ln-3004"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>         <span class="kd">::</span> <span class="n">val</span>
<a name="ln-3005"></a>   <span class="k">call </span><span class="n">locate_key</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>                     <span class="c">! find where string is or should be</span>
<a name="ln-3006"></a>   <span class="k">if</span><span class="p">(</span><span class="n">place</span> <span class="o">&gt;</span> <span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                  <span class="c">! if index is valid return strings</span>
<a name="ln-3007"></a>      <span class="n">val</span><span class="o">=</span><span class="n">unquote</span><span class="p">(</span><span class="n">values</span><span class="p">(</span><span class="n">place</span><span class="p">)(:</span><span class="n">counts</span><span class="p">(</span><span class="n">place</span><span class="p">)))</span>
<a name="ln-3008"></a>      <span class="k">call </span><span class="n">split</span><span class="p">(</span><span class="n">val</span><span class="p">,</span><span class="n">strings</span><span class="p">,</span><span class="n">delimiters</span><span class="o">=</span><span class="n">delimiters</span><span class="p">)</span>   <span class="c">! find value associated with keyword and split it into an array</span>
<a name="ln-3009"></a>   <span class="k">else</span>
<a name="ln-3010"></a><span class="k">      call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*get_anyarray_c* unknown keyword &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-3011"></a>      <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">12</span><span class="p">,</span><span class="s1">&#39;*get_anyarray_c* unknown keyword &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-3012"></a>      <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">strings</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">strings</span><span class="p">)</span>
<a name="ln-3013"></a>      <span class="k">allocate</span><span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">0</span><span class="p">)</span><span class="kd">::</span><span class="n">strings</span><span class="p">(</span><span class="mi">0</span><span class="p">))</span>
<a name="ln-3014"></a>   <span class="k">endif</span>
<a name="ln-3015"></a><span class="k">end subroutine </span><span class="n">get_anyarray_c</span>
<a name="ln-3016"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3017"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3018"></a><span class="k">subroutine </span><span class="n">get_args_fixed_length_a_array</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">strings</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-3019"></a>
<a name="ln-3020"></a><span class="c">! ident_9=&quot;@(#)M_CLI2::get_args_fixed_length_a_array(3f): Fetch strings value for specified KEYWORD from the lang. dictionary&quot;</span>
<a name="ln-3021"></a>
<a name="ln-3022"></a><span class="c">! This routine trusts that the desired keyword exists. A blank is returned if the keyword is not in the dictionary</span>
<a name="ln-3023"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">keyword</span>       <span class="c">! name to look up in dictionary</span>
<a name="ln-3024"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">allocatable</span>         <span class="kd">::</span> <span class="n">strings</span><span class="p">(:)</span>
<a name="ln-3025"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">delimiters</span>
<a name="ln-3026"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>         <span class="kd">::</span> <span class="n">strings_a</span><span class="p">(:)</span>
<a name="ln-3027"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">place</span>
<a name="ln-3028"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>         <span class="kd">::</span> <span class="n">val</span>
<a name="ln-3029"></a>   <span class="k">call </span><span class="n">locate_key</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>                     <span class="c">! find where string is or should be</span>
<a name="ln-3030"></a>   <span class="k">if</span><span class="p">(</span><span class="n">place</span> <span class="o">&gt;</span> <span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                  <span class="c">! if index is valid return strings</span>
<a name="ln-3031"></a>      <span class="n">val</span><span class="o">=</span><span class="n">unquote</span><span class="p">(</span><span class="n">values</span><span class="p">(</span><span class="n">place</span><span class="p">)(:</span><span class="n">counts</span><span class="p">(</span><span class="n">place</span><span class="p">)))</span>
<a name="ln-3032"></a>      <span class="k">call </span><span class="n">split</span><span class="p">(</span><span class="n">val</span><span class="p">,</span><span class="n">strings_a</span><span class="p">,</span><span class="n">delimiters</span><span class="o">=</span><span class="n">delimiters</span><span class="p">)</span>   <span class="c">! find value associated with keyword and split it into an array</span>
<a name="ln-3033"></a>      <span class="k">if</span><span class="p">(</span><span class="nb">len</span><span class="p">(</span><span class="n">strings_a</span><span class="p">).</span><span class="n">le</span><span class="p">.</span><span class="nb">len</span><span class="p">(</span><span class="n">strings</span><span class="p">))</span><span class="k">then</span>
<a name="ln-3034"></a><span class="k">         </span><span class="n">strings</span><span class="o">=</span><span class="n">strings_a</span>
<a name="ln-3035"></a>      <span class="k">else</span>
<a name="ln-3036"></a><span class="k">         call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*get_args_fixed_length_a_array* values too long. Longest is&#39;</span><span class="p">,</span><span class="nb">len</span><span class="p">(</span><span class="n">strings_a</span><span class="p">),</span><span class="s1">&#39;allowed is&#39;</span><span class="p">,</span><span class="nb">len</span><span class="p">(</span><span class="n">strings</span><span class="p">))</span>
<a name="ln-3037"></a>         <span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="s1">&#39;(&quot;strings=&quot;,3x,*(a,1x))&#39;</span><span class="p">)</span><span class="n">strings</span>
<a name="ln-3038"></a>         <span class="k">call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*get_args_fixed_length_a_array* keyword=&#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-3039"></a>         <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">13</span><span class="p">,</span><span class="s1">&#39;*get_args_fixed_length_a_array* keyword=&#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-3040"></a>         <span class="n">strings</span><span class="o">=</span><span class="p">[</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">strings</span><span class="p">))</span> <span class="kd">::</span><span class="p">]</span>
<a name="ln-3041"></a>      <span class="k">endif</span>
<a name="ln-3042"></a><span class="k">   else</span>
<a name="ln-3043"></a><span class="k">      call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*get_args_fixed_length_a_array* unknown keyword &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-3044"></a>      <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">14</span><span class="p">,</span><span class="s1">&#39;*get_args_fixed_length_a_array* unknown keyword &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-3045"></a>      <span class="n">strings</span><span class="o">=</span><span class="p">[</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">strings</span><span class="p">))</span> <span class="kd">::</span><span class="p">]</span>
<a name="ln-3046"></a>   <span class="k">endif</span>
<a name="ln-3047"></a><span class="k">end subroutine </span><span class="n">get_args_fixed_length_a_array</span>
<a name="ln-3048"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3049"></a><span class="c">! return non-allocatable arrays</span>
<a name="ln-3050"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3051"></a><span class="k">subroutine </span><span class="n">get_fixedarray_i</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">iarray</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-3052"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">keyword</span>      <span class="c">! keyword to retrieve value from dictionary</span>
<a name="ln-3053"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">iarray</span><span class="p">(:)</span>
<a name="ln-3054"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">delimiters</span>
<a name="ln-3055"></a><span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">dp</span><span class="p">),</span><span class="k">allocatable</span>            <span class="kd">::</span> <span class="n">darray</span><span class="p">(:)</span>    <span class="c">! function type</span>
<a name="ln-3056"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">dsize</span>
<a name="ln-3057"></a>   <span class="k">call </span><span class="n">get_anyarray_d</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">darray</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-3058"></a>   <span class="n">dsize</span><span class="o">=</span><span class="n">size</span><span class="p">(</span><span class="n">darray</span><span class="p">)</span>
<a name="ln-3059"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">ubound</span><span class="p">(</span><span class="n">iarray</span><span class="p">,</span><span class="nb">dim</span><span class="o">=</span><span class="mi">1</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="n">dsize</span><span class="p">)</span><span class="k">then</span>
<a name="ln-3060"></a><span class="k">      </span><span class="n">iarray</span><span class="o">=</span><span class="nb">nint</span><span class="p">(</span><span class="n">darray</span><span class="p">)</span>
<a name="ln-3061"></a>   <span class="k">else</span>
<a name="ln-3062"></a><span class="k">      call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*get_fixedarray_i* wrong number of values for keyword&#39;</span><span class="p">,</span><span class="n">keyword</span><span class="p">,</span><span class="s1">&#39;got&#39;</span><span class="p">,</span><span class="n">dsize</span><span class="p">,</span><span class="s1">&#39;expected&#39;</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">iarray</span><span class="p">))</span>
<a name="ln-3063"></a>      <span class="k">call </span><span class="n">print_dictionary</span><span class="p">(</span><span class="s1">&#39;USAGE:&#39;</span><span class="p">)</span>
<a name="ln-3064"></a>      <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">33</span><span class="p">)</span>
<a name="ln-3065"></a>      <span class="n">iarray</span><span class="o">=</span><span class="mi">0</span>
<a name="ln-3066"></a>   <span class="k">endif</span>
<a name="ln-3067"></a><span class="k">end subroutine </span><span class="n">get_fixedarray_i</span>
<a name="ln-3068"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3069"></a><span class="k">subroutine </span><span class="n">get_fixedarray_r</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">rarray</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-3070"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">keyword</span>      <span class="c">! keyword to retrieve value from dictionary</span>
<a name="ln-3071"></a><span class="kt">real</span>                                 <span class="kd">::</span> <span class="n">rarray</span><span class="p">(:)</span>
<a name="ln-3072"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">delimiters</span>
<a name="ln-3073"></a><span class="kt">real</span><span class="p">,</span><span class="k">allocatable</span>                     <span class="kd">::</span> <span class="n">darray</span><span class="p">(:)</span>    <span class="c">! function type</span>
<a name="ln-3074"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">dsize</span>
<a name="ln-3075"></a>   <span class="k">call </span><span class="n">get_anyarray_r</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">darray</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-3076"></a>   <span class="n">dsize</span><span class="o">=</span><span class="n">size</span><span class="p">(</span><span class="n">darray</span><span class="p">)</span>
<a name="ln-3077"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">ubound</span><span class="p">(</span><span class="n">rarray</span><span class="p">,</span><span class="nb">dim</span><span class="o">=</span><span class="mi">1</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="n">dsize</span><span class="p">)</span><span class="k">then</span>
<a name="ln-3078"></a><span class="k">      </span><span class="n">rarray</span><span class="o">=</span><span class="n">darray</span>
<a name="ln-3079"></a>   <span class="k">else</span>
<a name="ln-3080"></a><span class="k">      call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*get_fixedarray_r* wrong number of values for keyword&#39;</span><span class="p">,</span><span class="n">keyword</span><span class="p">,</span><span class="s1">&#39;got&#39;</span><span class="p">,</span><span class="n">dsize</span><span class="p">,</span><span class="s1">&#39;expected&#39;</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">rarray</span><span class="p">))</span>
<a name="ln-3081"></a>      <span class="k">call </span><span class="n">print_dictionary</span><span class="p">(</span><span class="s1">&#39;USAGE:&#39;</span><span class="p">)</span>
<a name="ln-3082"></a>      <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">33</span><span class="p">)</span>
<a name="ln-3083"></a>      <span class="n">rarray</span><span class="o">=</span><span class="mf">0.0</span>
<a name="ln-3084"></a>   <span class="k">endif</span>
<a name="ln-3085"></a><span class="k">end subroutine </span><span class="n">get_fixedarray_r</span>
<a name="ln-3086"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3087"></a><span class="k">subroutine </span><span class="n">get_fixed_size_complex</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">xarray</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-3088"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">keyword</span>      <span class="c">! keyword to retrieve value from dictionary</span>
<a name="ln-3089"></a><span class="kt">complex</span>                              <span class="kd">::</span> <span class="n">xarray</span><span class="p">(:)</span>
<a name="ln-3090"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">delimiters</span>
<a name="ln-3091"></a><span class="kt">complex</span><span class="p">,</span><span class="k">allocatable</span>                  <span class="kd">::</span> <span class="n">darray</span><span class="p">(:)</span>    <span class="c">! function type</span>
<a name="ln-3092"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">half</span><span class="p">,</span> <span class="n">sz</span>
<a name="ln-3093"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">dsize</span>
<a name="ln-3094"></a>   <span class="k">call </span><span class="n">get_anyarray_x</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">darray</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-3095"></a>   <span class="n">dsize</span><span class="o">=</span><span class="n">size</span><span class="p">(</span><span class="n">darray</span><span class="p">)</span>
<a name="ln-3096"></a>   <span class="n">sz</span><span class="o">=</span><span class="n">dsize</span><span class="o">*</span><span class="mi">2</span>
<a name="ln-3097"></a>   <span class="n">half</span><span class="o">=</span><span class="n">sz</span><span class="o">/</span><span class="mi">2</span>
<a name="ln-3098"></a>   <span class="k">if</span><span class="p">(</span><span class="n">sz</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="n">half</span><span class="o">+</span><span class="n">half</span><span class="p">)</span><span class="k">then</span>
<a name="ln-3099"></a><span class="k">      call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*get_fixed_size_complex* uneven number of values defining complex value &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-3100"></a>      <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">15</span><span class="p">,</span><span class="s1">&#39;*get_fixed_size_complex* uneven number of values defining complex value &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-3101"></a>      <span class="n">xarray</span><span class="o">=</span><span class="mi">0</span>
<a name="ln-3102"></a>      <span class="k">return</span>
<a name="ln-3103"></a><span class="k">   endif</span>
<a name="ln-3104"></a><span class="k">   if</span><span class="p">(</span><span class="nb">ubound</span><span class="p">(</span><span class="n">xarray</span><span class="p">,</span><span class="nb">dim</span><span class="o">=</span><span class="mi">1</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="n">dsize</span><span class="p">)</span><span class="k">then</span>
<a name="ln-3105"></a><span class="k">      </span><span class="n">xarray</span><span class="o">=</span><span class="n">darray</span>
<a name="ln-3106"></a>   <span class="k">else</span>
<a name="ln-3107"></a><span class="k">      call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*get_fixed_size_complex* wrong number of values for keyword&#39;</span><span class="p">,</span><span class="n">keyword</span><span class="p">,</span><span class="s1">&#39;got&#39;</span><span class="p">,</span><span class="n">dsize</span><span class="p">,</span><span class="s1">&#39;expected&#39;</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">xarray</span><span class="p">))</span>
<a name="ln-3108"></a>      <span class="k">call </span><span class="n">print_dictionary</span><span class="p">(</span><span class="s1">&#39;USAGE:&#39;</span><span class="p">)</span>
<a name="ln-3109"></a>      <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">34</span><span class="p">)</span>
<a name="ln-3110"></a>      <span class="n">xarray</span><span class="o">=</span><span class="nb">cmplx</span><span class="p">(</span><span class="mf">0.0</span><span class="p">,</span><span class="mf">0.0</span><span class="p">)</span>
<a name="ln-3111"></a>   <span class="k">endif</span>
<a name="ln-3112"></a><span class="k">end subroutine </span><span class="n">get_fixed_size_complex</span>
<a name="ln-3113"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3114"></a><span class="k">subroutine </span><span class="n">get_fixedarray_d</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">darr</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-3115"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">keyword</span>      <span class="c">! keyword to retrieve value from dictionary</span>
<a name="ln-3116"></a><span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">dp</span><span class="p">)</span>                        <span class="kd">::</span> <span class="n">darr</span><span class="p">(:)</span>
<a name="ln-3117"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">delimiters</span>
<a name="ln-3118"></a><span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">dp</span><span class="p">),</span><span class="k">allocatable</span>            <span class="kd">::</span> <span class="n">darray</span><span class="p">(:)</span>    <span class="c">! function type</span>
<a name="ln-3119"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">dsize</span>
<a name="ln-3120"></a>   <span class="k">call </span><span class="n">get_anyarray_d</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">darray</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-3121"></a>   <span class="n">dsize</span><span class="o">=</span><span class="n">size</span><span class="p">(</span><span class="n">darray</span><span class="p">)</span>
<a name="ln-3122"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">ubound</span><span class="p">(</span><span class="n">darr</span><span class="p">,</span><span class="nb">dim</span><span class="o">=</span><span class="mi">1</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="n">dsize</span><span class="p">)</span><span class="k">then</span>
<a name="ln-3123"></a><span class="k">      </span><span class="n">darr</span><span class="o">=</span><span class="n">darray</span>
<a name="ln-3124"></a>   <span class="k">else</span>
<a name="ln-3125"></a><span class="k">      call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*get_fixedarray_d* wrong number of values for keyword&#39;</span><span class="p">,</span><span class="n">keyword</span><span class="p">,</span><span class="s1">&#39;got&#39;</span><span class="p">,</span><span class="n">dsize</span><span class="p">,</span><span class="s1">&#39;expected&#39;</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">darr</span><span class="p">))</span>
<a name="ln-3126"></a>      <span class="k">call </span><span class="n">print_dictionary</span><span class="p">(</span><span class="s1">&#39;USAGE:&#39;</span><span class="p">)</span>
<a name="ln-3127"></a>      <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">35</span><span class="p">)</span>
<a name="ln-3128"></a>      <span class="n">darr</span><span class="o">=</span><span class="mf">0.0d0</span>
<a name="ln-3129"></a>   <span class="k">endif</span>
<a name="ln-3130"></a><span class="k">end subroutine </span><span class="n">get_fixedarray_d</span>
<a name="ln-3131"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3132"></a><span class="k">subroutine </span><span class="n">get_fixedarray_l</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">larray</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-3133"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">keyword</span>      <span class="c">! keyword to retrieve value from dictionary</span>
<a name="ln-3134"></a><span class="kt">logical</span>                              <span class="kd">::</span> <span class="n">larray</span><span class="p">(:)</span>
<a name="ln-3135"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">delimiters</span>
<a name="ln-3136"></a><span class="kt">logical</span><span class="p">,</span><span class="k">allocatable</span>                  <span class="kd">::</span> <span class="n">darray</span><span class="p">(:)</span>    <span class="c">! function type</span>
<a name="ln-3137"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">dsize</span>
<a name="ln-3138"></a>   <span class="k">call </span><span class="n">get_anyarray_l</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">darray</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-3139"></a>   <span class="n">dsize</span><span class="o">=</span><span class="n">size</span><span class="p">(</span><span class="n">darray</span><span class="p">)</span>
<a name="ln-3140"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">ubound</span><span class="p">(</span><span class="n">larray</span><span class="p">,</span><span class="nb">dim</span><span class="o">=</span><span class="mi">1</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="n">dsize</span><span class="p">)</span><span class="k">then</span>
<a name="ln-3141"></a><span class="k">      </span><span class="n">larray</span><span class="o">=</span><span class="n">darray</span>
<a name="ln-3142"></a>   <span class="k">else</span>
<a name="ln-3143"></a><span class="k">      call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*get_fixedarray_l* wrong number of values for keyword&#39;</span><span class="p">,</span><span class="n">keyword</span><span class="p">,</span><span class="s1">&#39;got&#39;</span><span class="p">,</span><span class="n">dsize</span><span class="p">,</span><span class="s1">&#39;expected&#39;</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">larray</span><span class="p">))</span>
<a name="ln-3144"></a>      <span class="k">call </span><span class="n">print_dictionary</span><span class="p">(</span><span class="s1">&#39;USAGE:&#39;</span><span class="p">)</span>
<a name="ln-3145"></a>      <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">36</span><span class="p">)</span>
<a name="ln-3146"></a>      <span class="n">larray</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>
<a name="ln-3147"></a>   <span class="k">endif</span>
<a name="ln-3148"></a><span class="k">end subroutine </span><span class="n">get_fixedarray_l</span>
<a name="ln-3149"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3150"></a><span class="k">subroutine </span><span class="n">get_fixedarray_fixed_length_c</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">strings</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>
<a name="ln-3151"></a>
<a name="ln-3152"></a><span class="c">! ident_10=&quot;@(#)M_CLI2::get_fixedarray_fixed_length_c(3f): Fetch strings value for specified KEYWORD from the lang. dictionary&quot;</span>
<a name="ln-3153"></a>
<a name="ln-3154"></a><span class="c">! This routine trusts that the desired keyword exists. A blank is returned if the keyword is not in the dictionary</span>
<a name="ln-3155"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">)</span>                     <span class="kd">::</span> <span class="n">strings</span><span class="p">(:)</span>
<a name="ln-3156"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">delimiters</span>
<a name="ln-3157"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>         <span class="kd">::</span> <span class="n">str</span><span class="p">(:)</span>
<a name="ln-3158"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">keyword</span>   <span class="c">! name to look up in dictionary</span>
<a name="ln-3159"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">place</span>
<a name="ln-3160"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">ssize</span>
<a name="ln-3161"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>         <span class="kd">::</span> <span class="n">val</span>
<a name="ln-3162"></a>   <span class="k">call </span><span class="n">locate_key</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>                 <span class="c">! find where string is or should be</span>
<a name="ln-3163"></a>   <span class="k">if</span><span class="p">(</span><span class="n">place</span> <span class="o">&gt;</span> <span class="mi">0</span><span class="p">)</span><span class="k">then</span>                              <span class="c">! if index is valid return strings</span>
<a name="ln-3164"></a>      <span class="n">val</span><span class="o">=</span><span class="n">unquote</span><span class="p">(</span><span class="n">values</span><span class="p">(</span><span class="n">place</span><span class="p">)(:</span><span class="n">counts</span><span class="p">(</span><span class="n">place</span><span class="p">)))</span>
<a name="ln-3165"></a>      <span class="k">call </span><span class="n">split</span><span class="p">(</span><span class="n">val</span><span class="p">,</span><span class="n">str</span><span class="p">,</span><span class="n">delimiters</span><span class="o">=</span><span class="n">delimiters</span><span class="p">)</span>   <span class="c">! find value associated with keyword and split it into an array</span>
<a name="ln-3166"></a>      <span class="n">ssize</span><span class="o">=</span><span class="n">size</span><span class="p">(</span><span class="n">str</span><span class="p">)</span>
<a name="ln-3167"></a>      <span class="k">if</span><span class="p">(</span><span class="n">ssize</span><span class="o">==</span><span class="n">size</span><span class="p">(</span><span class="n">strings</span><span class="p">))</span><span class="k">then</span>
<a name="ln-3168"></a><span class="k">         </span><span class="n">strings</span><span class="p">(:</span><span class="n">ssize</span><span class="p">)</span><span class="o">=</span><span class="n">str</span>
<a name="ln-3169"></a>      <span class="k">else</span>
<a name="ln-3170"></a><span class="k">         call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*get_fixedarray_fixed_length_c* wrong number of values for keyword&#39;</span><span class="p">,&amp;</span>
<a name="ln-3171"></a>            <span class="p">&amp;</span> <span class="n">keyword</span><span class="p">,</span><span class="s1">&#39;got&#39;</span><span class="p">,</span><span class="n">ssize</span><span class="p">,</span><span class="s1">&#39;expected &#39;</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">strings</span><span class="p">))</span> <span class="c">!,ubound(strings,dim=1)</span>
<a name="ln-3172"></a>         <span class="k">call </span><span class="n">print_dictionary</span><span class="p">(</span><span class="s1">&#39;USAGE:&#39;</span><span class="p">)</span>
<a name="ln-3173"></a>         <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">30</span><span class="p">,</span><span class="s1">&#39;*get_fixedarray_fixed_length_c* unknown keyword &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-3174"></a>         <span class="n">strings</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-3175"></a>      <span class="k">endif</span>
<a name="ln-3176"></a><span class="k">   else</span>
<a name="ln-3177"></a><span class="k">      call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*get_fixedarray_fixed_length_c* unknown keyword &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-3178"></a>      <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">16</span><span class="p">,</span><span class="s1">&#39;*get_fixedarray_fixed_length_c* unknown keyword &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-3179"></a>      <span class="n">strings</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-3180"></a>   <span class="k">endif</span>
<a name="ln-3181"></a><span class="k">end subroutine </span><span class="n">get_fixedarray_fixed_length_c</span>
<a name="ln-3182"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3183"></a><span class="c">! return scalars</span>
<a name="ln-3184"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3185"></a><span class="k">subroutine </span><span class="n">get_scalar_d</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">d</span><span class="p">)</span>
<a name="ln-3186"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>   <span class="kd">::</span> <span class="n">keyword</span>      <span class="c">! keyword to retrieve value from dictionary</span>
<a name="ln-3187"></a><span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">dp</span><span class="p">)</span>                 <span class="kd">::</span> <span class="n">d</span>
<a name="ln-3188"></a><span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">dp</span><span class="p">),</span><span class="k">allocatable</span>     <span class="kd">::</span> <span class="n">darray</span><span class="p">(:)</span>    <span class="c">! function type</span>
<a name="ln-3189"></a>   <span class="k">call </span><span class="n">get_anyarray_d</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">darray</span><span class="p">)</span>
<a name="ln-3190"></a>   <span class="k">if</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">darray</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="mi">1</span><span class="p">)</span><span class="k">then</span>
<a name="ln-3191"></a><span class="k">      </span><span class="n">d</span><span class="o">=</span><span class="n">darray</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span>
<a name="ln-3192"></a>   <span class="k">else</span>
<a name="ln-3193"></a><span class="k">      call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*get_anyarray_d* incorrect number of values for keyword&#39;</span><span class="p">,</span><span class="n">keyword</span><span class="p">,</span><span class="s1">&#39;expected one found&#39;</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">darray</span><span class="p">))</span>
<a name="ln-3194"></a>      <span class="k">call </span><span class="n">print_dictionary</span><span class="p">(</span><span class="s1">&#39;USAGE:&#39;</span><span class="p">)</span>
<a name="ln-3195"></a>      <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">31</span><span class="p">,</span><span class="s1">&#39;*get_anyarray_d* incorrect number of values for keyword&#39;</span><span class="o">//</span><span class="n">keyword</span><span class="o">//</span><span class="s1">&#39;expected one&#39;</span><span class="p">)</span>
<a name="ln-3196"></a>   <span class="k">endif</span>
<a name="ln-3197"></a><span class="k">end subroutine </span><span class="n">get_scalar_d</span>
<a name="ln-3198"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3199"></a><span class="k">subroutine </span><span class="n">get_scalar_real</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">r</span><span class="p">)</span>
<a name="ln-3200"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>   <span class="kd">::</span> <span class="n">keyword</span>      <span class="c">! keyword to retrieve value from dictionary</span>
<a name="ln-3201"></a><span class="kt">real</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span>              <span class="kd">::</span> <span class="n">r</span>
<a name="ln-3202"></a><span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">dp</span><span class="p">)</span>                 <span class="kd">::</span> <span class="n">d</span>
<a name="ln-3203"></a>   <span class="k">call </span><span class="n">get_scalar_d</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">d</span><span class="p">)</span>
<a name="ln-3204"></a>   <span class="n">r</span><span class="o">=</span><span class="kt">real</span><span class="p">(</span><span class="n">d</span><span class="p">)</span>
<a name="ln-3205"></a><span class="k">end subroutine </span><span class="n">get_scalar_real</span>
<a name="ln-3206"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3207"></a><span class="k">subroutine </span><span class="n">get_scalar_i</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">i</span><span class="p">)</span>
<a name="ln-3208"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>   <span class="kd">::</span> <span class="n">keyword</span>      <span class="c">! keyword to retrieve value from dictionary</span>
<a name="ln-3209"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span>           <span class="kd">::</span> <span class="n">i</span>
<a name="ln-3210"></a><span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">dp</span><span class="p">)</span>                 <span class="kd">::</span> <span class="n">d</span>
<a name="ln-3211"></a>   <span class="k">call </span><span class="n">get_scalar_d</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">d</span><span class="p">)</span>
<a name="ln-3212"></a>   <span class="n">i</span><span class="o">=</span><span class="nb">nint</span><span class="p">(</span><span class="n">d</span><span class="p">)</span>
<a name="ln-3213"></a><span class="k">end subroutine </span><span class="n">get_scalar_i</span>
<a name="ln-3214"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3215"></a><span class="k">subroutine </span><span class="n">get_scalar_anylength_c</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">string</span><span class="p">)</span>
<a name="ln-3216"></a>
<a name="ln-3217"></a><span class="c">! ident_11=&quot;@(#)M_CLI2::get_scalar_anylength_c(3f): Fetch string value for specified KEYWORD from the lang. dictionary&quot;</span>
<a name="ln-3218"></a>
<a name="ln-3219"></a><span class="c">! This routine trusts that the desired keyword exists. A blank is returned if the keyword is not in the dictionary</span>
<a name="ln-3220"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>   <span class="kd">::</span> <span class="n">keyword</span>              <span class="c">! name to look up in dictionary</span>
<a name="ln-3221"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span>  <span class="kd">::</span> <span class="n">string</span>
<a name="ln-3222"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">place</span>
<a name="ln-3223"></a>   <span class="k">call </span><span class="n">locate_key</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>                     <span class="c">! find where string is or should be</span>
<a name="ln-3224"></a>   <span class="k">if</span><span class="p">(</span><span class="n">place</span> <span class="o">&gt;</span> <span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                  <span class="c">! if index is valid return string</span>
<a name="ln-3225"></a>      <span class="n">string</span><span class="o">=</span><span class="n">unquote</span><span class="p">(</span><span class="n">values</span><span class="p">(</span><span class="n">place</span><span class="p">)(:</span><span class="n">counts</span><span class="p">(</span><span class="n">place</span><span class="p">)))</span>
<a name="ln-3226"></a>   <span class="k">else</span>
<a name="ln-3227"></a><span class="k">      call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">17</span><span class="p">,</span><span class="s1">&#39;*get_anyarray_c* unknown keyword &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-3228"></a>      <span class="k">call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*get_anyarray_c* unknown keyword &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-3229"></a>      <span class="n">string</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-3230"></a>   <span class="k">endif</span>
<a name="ln-3231"></a><span class="k">end subroutine </span><span class="n">get_scalar_anylength_c</span>
<a name="ln-3232"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3233"></a><span class="k">elemental impure subroutine </span><span class="n">get_args_fixed_length_scalar_c</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">string</span><span class="p">)</span>
<a name="ln-3234"></a>
<a name="ln-3235"></a><span class="c">! ident_12=&quot;@(#)M_CLI2::get_args_fixed_length_scalar_c(3f): Fetch string value for specified KEYWORD from the lang. dictionary&quot;</span>
<a name="ln-3236"></a>
<a name="ln-3237"></a><span class="c">! This routine trusts that the desired keyword exists. A blank is returned if the keyword is not in the dictionary</span>
<a name="ln-3238"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>   <span class="kd">::</span> <span class="n">keyword</span>              <span class="c">! name to look up in dictionary</span>
<a name="ln-3239"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span>  <span class="kd">::</span> <span class="n">string</span>
<a name="ln-3240"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">place</span>
<a name="ln-3241"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">unlen</span>
<a name="ln-3242"></a>   <span class="k">call </span><span class="n">locate_key</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>                     <span class="c">! find where string is or should be</span>
<a name="ln-3243"></a>   <span class="k">if</span><span class="p">(</span><span class="n">place</span> <span class="o">&gt;</span> <span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                  <span class="c">! if index is valid return string</span>
<a name="ln-3244"></a>      <span class="n">string</span><span class="o">=</span><span class="n">unquote</span><span class="p">(</span><span class="n">values</span><span class="p">(</span><span class="n">place</span><span class="p">)(:</span><span class="n">counts</span><span class="p">(</span><span class="n">place</span><span class="p">)))</span>
<a name="ln-3245"></a>   <span class="k">else</span>
<a name="ln-3246"></a><span class="k">      call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">18</span><span class="p">,</span><span class="s1">&#39;*get_args_fixed_length_scalar_c* unknown keyword &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-3247"></a>      <span class="n">string</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-3248"></a>   <span class="k">endif</span>
<a name="ln-3249"></a><span class="k">   </span><span class="n">unlen</span><span class="o">=</span><span class="nb">len_trim</span><span class="p">(</span><span class="n">unquote</span><span class="p">(</span><span class="n">values</span><span class="p">(</span><span class="n">place</span><span class="p">)(:</span><span class="n">counts</span><span class="p">(</span><span class="n">place</span><span class="p">))))</span>
<a name="ln-3250"></a>   <span class="k">if</span><span class="p">(</span><span class="n">unlen</span><span class="o">&gt;</span><span class="nb">len</span><span class="p">(</span><span class="n">string</span><span class="p">))</span><span class="k">then</span>
<a name="ln-3251"></a><span class="k">      call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*get_args_fixed_length_scalar_c* value too long for&#39;</span><span class="p">,</span><span class="n">keyword</span><span class="p">,</span><span class="s1">&#39;allowed is&#39;</span><span class="p">,</span><span class="nb">len</span><span class="p">(</span><span class="n">string</span><span class="p">),&amp;</span>
<a name="ln-3252"></a>      <span class="p">&amp;</span> <span class="s1">&#39;input string [&#39;</span><span class="p">,</span><span class="n">values</span><span class="p">(</span><span class="n">place</span><span class="p">),</span><span class="s1">&#39;] is&#39;</span><span class="p">,</span><span class="n">unlen</span><span class="p">)</span>
<a name="ln-3253"></a>      <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">19</span><span class="p">,</span><span class="s1">&#39;*get_args_fixed_length_scalar_c* value too long&#39;</span><span class="p">)</span>
<a name="ln-3254"></a>      <span class="n">string</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-3255"></a>   <span class="k">endif</span>
<a name="ln-3256"></a><span class="k">end subroutine </span><span class="n">get_args_fixed_length_scalar_c</span>
<a name="ln-3257"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3258"></a><span class="k">subroutine </span><span class="n">get_scalar_complex</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">x</span><span class="p">)</span>
<a name="ln-3259"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">keyword</span>      <span class="c">! keyword to retrieve value from dictionary</span>
<a name="ln-3260"></a><span class="kt">complex</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span>         <span class="kd">::</span> <span class="n">x</span>
<a name="ln-3261"></a><span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">dp</span><span class="p">)</span>               <span class="kd">::</span> <span class="n">d</span><span class="p">(</span><span class="mi">2</span><span class="p">)</span>
<a name="ln-3262"></a>   <span class="k">call </span><span class="n">get_fixedarray_d</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">d</span><span class="p">)</span>
<a name="ln-3263"></a>   <span class="k">if</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">d</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="mi">2</span><span class="p">)</span><span class="k">then</span>
<a name="ln-3264"></a><span class="k">      </span><span class="n">x</span><span class="o">=</span><span class="nb">cmplx</span><span class="p">(</span><span class="n">d</span><span class="p">(</span><span class="mi">1</span><span class="p">),</span><span class="n">d</span><span class="p">(</span><span class="mi">2</span><span class="p">),</span><span class="nb">kind</span><span class="o">=</span><span class="n">sp</span><span class="p">)</span>
<a name="ln-3265"></a>   <span class="k">else</span>
<a name="ln-3266"></a><span class="k">      call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*get_scalar_complex* expected two values found&#39;</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">d</span><span class="p">))</span>
<a name="ln-3267"></a>      <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">20</span><span class="p">,</span><span class="s1">&#39;*get_scalar_complex* incorrect number of values for keyword &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-3268"></a>      <span class="n">x</span><span class="o">=</span><span class="nb">cmplx</span><span class="p">(</span><span class="mf">0.0</span><span class="p">,</span><span class="mf">0.0</span><span class="p">)</span>
<a name="ln-3269"></a>   <span class="k">endif</span>
<a name="ln-3270"></a><span class="k">end subroutine </span><span class="n">get_scalar_complex</span>
<a name="ln-3271"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3272"></a><span class="k">subroutine </span><span class="n">get_scalar_logical</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">l</span><span class="p">)</span>
<a name="ln-3273"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>   <span class="kd">::</span> <span class="n">keyword</span>      <span class="c">! keyword to retrieve value from dictionary</span>
<a name="ln-3274"></a><span class="kt">logical</span>                       <span class="kd">::</span> <span class="n">l</span>
<a name="ln-3275"></a><span class="kt">logical</span><span class="p">,</span><span class="k">allocatable</span>           <span class="kd">::</span> <span class="n">larray</span><span class="p">(:)</span>    <span class="c">! function type</span>
<a name="ln-3276"></a>   <span class="k">call </span><span class="n">get_anyarray_l</span><span class="p">(</span><span class="n">keyword</span><span class="p">,</span><span class="n">larray</span><span class="p">)</span>
<a name="ln-3277"></a>   <span class="k">if</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">larray</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="mi">1</span><span class="p">)</span><span class="k">then</span>
<a name="ln-3278"></a><span class="k">      </span><span class="n">l</span><span class="o">=</span><span class="n">larray</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span>
<a name="ln-3279"></a>   <span class="k">else</span>
<a name="ln-3280"></a><span class="k">      call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*get_anyarray_l* expected one value found&#39;</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">larray</span><span class="p">))</span>
<a name="ln-3281"></a>      <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="mi">21</span><span class="p">,</span><span class="s1">&#39;*get_anyarray_l* incorrect number of values for keyword &#39;</span><span class="o">//</span><span class="n">keyword</span><span class="p">)</span>
<a name="ln-3282"></a>      <span class="n">l</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>
<a name="ln-3283"></a>   <span class="k">endif</span>
<a name="ln-3284"></a><span class="k">end subroutine </span><span class="n">get_scalar_logical</span>
<a name="ln-3285"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3286"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-3287"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3288"></a><span class="c">! THE REMAINDER SHOULD BE ROUTINES EXTRACTED FROM OTHER MODULES TO MAKE THIS MODULE STANDALONE BY POPULAR REQUEST</span>
<a name="ln-3289"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3290"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-3291"></a><span class="c">!use M_strings,                     only : UPPER, LOWER, QUOTE, REPLACE_STR=&gt;REPLACE, UNQUOTE, SPLIT, STRING_TO_VALUE</span>
<a name="ln-3292"></a><span class="c">!use M_list,                        only : insert, locate, remove, replace</span>
<a name="ln-3293"></a><span class="c">!use M_journal,                     only : JOURNAL</span>
<a name="ln-3294"></a>
<a name="ln-3295"></a><span class="c">!use M_args,                        only : LONGEST_COMMAND_ARGUMENT</span>
<a name="ln-3296"></a><span class="c">! routines extracted from other modules</span>
<a name="ln-3297"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3298"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-3299"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3300"></a><span class="c">!&gt;</span>
<a name="ln-3301"></a><span class="c">!!##NAME</span>
<a name="ln-3302"></a><span class="c">!!    longest_command_argument(3f) - [ARGUMENTS:M_args] length of longest</span>
<a name="ln-3303"></a><span class="c">!!    argument on command line</span>
<a name="ln-3304"></a><span class="c">!!    (LICENSE:PD)</span>
<a name="ln-3305"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-3306"></a><span class="c">!!</span>
<a name="ln-3307"></a><span class="c">!!    function longest_command_argument() result(ilongest)</span>
<a name="ln-3308"></a><span class="c">!!</span>
<a name="ln-3309"></a><span class="c">!!     integer :: ilongest</span>
<a name="ln-3310"></a><span class="c">!!</span>
<a name="ln-3311"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-3312"></a><span class="c">!!    length of longest argument on command line. Useful when allocating</span>
<a name="ln-3313"></a><span class="c">!!    storage for holding arguments.</span>
<a name="ln-3314"></a><span class="c">!!##RESULT</span>
<a name="ln-3315"></a><span class="c">!!    longest_command_argument  length of longest command argument</span>
<a name="ln-3316"></a><span class="c">!!##EXAMPLE</span>
<a name="ln-3317"></a><span class="c">!!</span>
<a name="ln-3318"></a><span class="c">!! Sample program</span>
<a name="ln-3319"></a><span class="c">!!</span>
<a name="ln-3320"></a><span class="c">!!      program demo_longest_command_argument</span>
<a name="ln-3321"></a><span class="c">!!      use M_args, only : longest_command_argument</span>
<a name="ln-3322"></a><span class="c">!!         write(*,*)&#39;longest argument is &#39;,longest_command_argument()</span>
<a name="ln-3323"></a><span class="c">!!      end program demo_longest_command_argument</span>
<a name="ln-3324"></a><span class="c">!!##AUTHOR</span>
<a name="ln-3325"></a><span class="c">!!    John S. Urban, 2019</span>
<a name="ln-3326"></a><span class="c">!!##LICENSE</span>
<a name="ln-3327"></a><span class="c">!!    Public Domain</span>
<a name="ln-3328"></a><span class="k">function </span><span class="n">longest_command_argument</span><span class="p">()</span> <span class="k">result</span><span class="p">(</span><span class="n">ilongest</span><span class="p">)</span>
<a name="ln-3329"></a><span class="kt">integer</span> <span class="kd">::</span> <span class="n">i</span>
<a name="ln-3330"></a><span class="kt">integer</span> <span class="kd">::</span> <span class="n">ilength</span>
<a name="ln-3331"></a><span class="kt">integer</span> <span class="kd">::</span> <span class="n">istatus</span>
<a name="ln-3332"></a><span class="kt">integer</span> <span class="kd">::</span> <span class="n">ilongest</span>
<a name="ln-3333"></a>   <span class="n">ilength</span><span class="o">=</span><span class="mi">0</span>
<a name="ln-3334"></a>   <span class="n">ilongest</span><span class="o">=</span><span class="mi">0</span>
<a name="ln-3335"></a>   <span class="n">GET_LONGEST</span><span class="p">:</span> <span class="k">do </span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="nb">command_argument_count</span><span class="p">()</span>                             <span class="c">! loop throughout command line arguments to find longest</span>
<a name="ln-3336"></a>      <span class="k">call </span><span class="nb">get_command_argument</span><span class="p">(</span><span class="n">number</span><span class="o">=</span><span class="n">i</span><span class="p">,</span><span class="n">length</span><span class="o">=</span><span class="n">ilength</span><span class="p">,</span><span class="n">status</span><span class="o">=</span><span class="n">istatus</span><span class="p">)</span>     <span class="c">! get next argument</span>
<a name="ln-3337"></a>      <span class="k">if</span><span class="p">(</span><span class="n">istatus</span> <span class="o">/=</span> <span class="mi">0</span><span class="p">)</span> <span class="k">then</span>                                                 <span class="c">! on error</span>
<a name="ln-3338"></a>         <span class="k">write</span><span class="p">(</span><span class="n">warn</span><span class="p">,</span><span class="o">*</span><span class="p">)</span><span class="s1">&#39;*prototype_and_cmd_args_to_nlist* error obtaining length for argument &#39;</span><span class="p">,</span><span class="n">i</span>
<a name="ln-3339"></a>         <span class="k">exit </span><span class="n">GET_LONGEST</span>
<a name="ln-3340"></a>      <span class="n">elseif</span><span class="p">(</span><span class="n">ilength</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-3341"></a><span class="k">         </span><span class="n">ilongest</span><span class="o">=</span><span class="nb">max</span><span class="p">(</span><span class="n">ilongest</span><span class="p">,</span><span class="n">ilength</span><span class="p">)</span>
<a name="ln-3342"></a>      <span class="k">endif</span>
<a name="ln-3343"></a><span class="k">   enddo </span><span class="n">GET_LONGEST</span>
<a name="ln-3344"></a><span class="k">end function </span><span class="n">longest_command_argument</span>
<a name="ln-3345"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3346"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-3347"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3348"></a><span class="k">subroutine </span><span class="n">journal</span><span class="p">(</span><span class="k">where</span><span class="p">,</span> <span class="n">g0</span><span class="p">,</span> <span class="n">g1</span><span class="p">,</span> <span class="n">g2</span><span class="p">,</span> <span class="n">g3</span><span class="p">,</span> <span class="n">g4</span><span class="p">,</span> <span class="n">g5</span><span class="p">,</span> <span class="n">g6</span><span class="p">,</span> <span class="n">g7</span><span class="p">,</span> <span class="n">g8</span><span class="p">,</span> <span class="n">g9</span><span class="p">,</span> <span class="n">ga</span><span class="p">,</span> <span class="n">gb</span><span class="p">,</span> <span class="n">gc</span><span class="p">,</span> <span class="n">gd</span><span class="p">,</span> <span class="n">ge</span><span class="p">,</span> <span class="n">gf</span><span class="p">,</span> <span class="n">gg</span><span class="p">,</span> <span class="n">gh</span><span class="p">,</span> <span class="n">gi</span><span class="p">,</span> <span class="n">gj</span><span class="p">,</span> <span class="n">sep</span><span class="p">)</span>
<a name="ln-3349"></a><span class="k">implicit none</span>
<a name="ln-3350"></a>
<a name="ln-3351"></a><span class="c">! ident_13=&quot;@(#)M_CLI2::journal(3f): writes a message to a string composed of any standard scalar types&quot;</span>
<a name="ln-3352"></a>
<a name="ln-3353"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>   <span class="kd">::</span> <span class="k">where</span>
<a name="ln-3354"></a><span class="k">class</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>           <span class="kd">::</span> <span class="n">g0</span>
<a name="ln-3355"></a><span class="k">class</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>  <span class="kd">::</span> <span class="n">g1</span><span class="p">,</span> <span class="n">g2</span><span class="p">,</span> <span class="n">g3</span><span class="p">,</span> <span class="n">g4</span><span class="p">,</span> <span class="n">g5</span><span class="p">,</span> <span class="n">g6</span><span class="p">,</span> <span class="n">g7</span><span class="p">,</span> <span class="n">g8</span> <span class="p">,</span><span class="n">g9</span>
<a name="ln-3356"></a><span class="k">class</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>  <span class="kd">::</span> <span class="n">ga</span><span class="p">,</span> <span class="n">gb</span><span class="p">,</span> <span class="n">gc</span><span class="p">,</span> <span class="n">gd</span><span class="p">,</span> <span class="n">ge</span><span class="p">,</span> <span class="n">gf</span><span class="p">,</span> <span class="n">gg</span><span class="p">,</span> <span class="n">gh</span> <span class="p">,</span><span class="n">gi</span><span class="p">,</span> <span class="n">gj</span>
<a name="ln-3357"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">sep</span>
<a name="ln-3358"></a><span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="o">*</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;JOURNAL:&#39;</span><span class="p">,</span><span class="nb">present</span><span class="p">(</span><span class="n">g1</span><span class="p">)</span>
<a name="ln-3359"></a><span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="o">*</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;JOURNAL:&#39;</span><span class="p">,</span><span class="nb">present</span><span class="p">(</span><span class="n">g2</span><span class="p">)</span>
<a name="ln-3360"></a><span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="o">*</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;JOURNAL:&#39;</span><span class="p">,</span><span class="nb">present</span><span class="p">(</span><span class="n">sep</span><span class="p">)</span>
<a name="ln-3361"></a><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="s1">&#39;(a)&#39;</span><span class="p">)</span><span class="n">str</span><span class="p">(</span><span class="n">g0</span><span class="p">,</span> <span class="n">g1</span><span class="p">,</span> <span class="n">g2</span><span class="p">,</span> <span class="n">g3</span><span class="p">,</span> <span class="n">g4</span><span class="p">,</span> <span class="n">g5</span><span class="p">,</span> <span class="n">g6</span><span class="p">,</span> <span class="n">g7</span><span class="p">,</span> <span class="n">g8</span><span class="p">,</span> <span class="n">g9</span><span class="p">,</span> <span class="n">ga</span><span class="p">,</span> <span class="n">gb</span><span class="p">,</span> <span class="n">gc</span><span class="p">,</span> <span class="n">gd</span><span class="p">,</span> <span class="n">ge</span><span class="p">,</span> <span class="n">gf</span><span class="p">,</span> <span class="n">gg</span><span class="p">,</span> <span class="n">gh</span><span class="p">,</span> <span class="n">gi</span><span class="p">,</span> <span class="n">gj</span><span class="p">,</span> <span class="n">sep</span><span class="p">)</span>
<a name="ln-3362"></a><span class="k">end subroutine </span><span class="n">journal</span>
<a name="ln-3363"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3364"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-3365"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3366"></a><span class="c">!&gt;</span>
<a name="ln-3367"></a><span class="c">!!##NAME</span>
<a name="ln-3368"></a><span class="c">!!    str(3f) - [M_CLI2] converts any standard scalar type to a string</span>
<a name="ln-3369"></a><span class="c">!!    (LICENSE:PD)</span>
<a name="ln-3370"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-3371"></a><span class="c">!!</span>
<a name="ln-3372"></a><span class="c">!!    function str(g0,g1,g2,g3,g4,g5,g6,g7,g8,g9,ga,gb,gc,gd,ge,gf,gg,gh,gi,gj,sep)</span>
<a name="ln-3373"></a><span class="c">!!</span>
<a name="ln-3374"></a><span class="c">!!     class(*),intent(in),optional  :: g0,g1,g2,g3,g4,g5,g6,g7,g8,g9</span>
<a name="ln-3375"></a><span class="c">!!     class(*),intent(in),optional  :: ga,gb,gc,gd,ge,gf,gg,gh,gi,gj</span>
<a name="ln-3376"></a><span class="c">!!     character(len=*),intent(in),optional :: sep</span>
<a name="ln-3377"></a><span class="c">!!     character,len=(:),allocatable :: str</span>
<a name="ln-3378"></a><span class="c">!!</span>
<a name="ln-3379"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-3380"></a><span class="c">!!    str(3f) builds a space-separated string from up to twenty scalar values.</span>
<a name="ln-3381"></a><span class="c">!!</span>
<a name="ln-3382"></a><span class="c">!!##OPTIONS</span>
<a name="ln-3383"></a><span class="c">!!    g[0-9a-j]   optional value to print the value of after the message. May</span>
<a name="ln-3384"></a><span class="c">!!                be of type INTEGER, LOGICAL, REAL, DOUBLEPRECISION,</span>
<a name="ln-3385"></a><span class="c">!!                COMPLEX, or CHARACTER.</span>
<a name="ln-3386"></a><span class="c">!!</span>
<a name="ln-3387"></a><span class="c">!!                Optionally, all the generic values can be</span>
<a name="ln-3388"></a><span class="c">!!                single-dimensioned arrays. Currently, mixing scalar</span>
<a name="ln-3389"></a><span class="c">!!                arguments and array arguments is not supported.</span>
<a name="ln-3390"></a><span class="c">!!</span>
<a name="ln-3391"></a><span class="c">!!    sep         separator to place between values. Defaults to a space.</span>
<a name="ln-3392"></a><span class="c">!!##RETURNS</span>
<a name="ln-3393"></a><span class="c">!!    str     description to print</span>
<a name="ln-3394"></a><span class="c">!!##EXAMPLES</span>
<a name="ln-3395"></a><span class="c">!!</span>
<a name="ln-3396"></a><span class="c">!! Sample program:</span>
<a name="ln-3397"></a><span class="c">!!</span>
<a name="ln-3398"></a><span class="c">!!       program demo_msg</span>
<a name="ln-3399"></a><span class="c">!!       use M_CLI2, only : str</span>
<a name="ln-3400"></a><span class="c">!!       implicit none</span>
<a name="ln-3401"></a><span class="c">!!       character(len=:),allocatable :: pr</span>
<a name="ln-3402"></a><span class="c">!!       character(len=:),allocatable :: frmt</span>
<a name="ln-3403"></a><span class="c">!!       integer                      :: biggest</span>
<a name="ln-3404"></a><span class="c">!!</span>
<a name="ln-3405"></a><span class="c">!!       pr=str(&#39;HUGE(3f) integers&#39;,huge(0),&#39;and real&#39;,&amp;</span>
<a name="ln-3406"></a><span class="c">!!               &amp; huge(0.0),&#39;and double&#39;,huge(0.0d0))</span>
<a name="ln-3407"></a><span class="c">!!       write(*,&#39;(a)&#39;)pr</span>
<a name="ln-3408"></a><span class="c">!!       pr=str(&#39;real            :&#39;,huge(0.0),0.0,12345.6789,tiny(0.0) )</span>
<a name="ln-3409"></a><span class="c">!!       write(*,&#39;(a)&#39;)pr</span>
<a name="ln-3410"></a><span class="c">!!       pr=str(&#39;doubleprecision :&#39;,huge(0.0d0),0.0d0,12345.6789d0,tiny(0.0d0) )</span>
<a name="ln-3411"></a><span class="c">!!       write(*,&#39;(a)&#39;)pr</span>
<a name="ln-3412"></a><span class="c">!!       pr=str(&#39;complex         :&#39;,cmplx(huge(0.0),tiny(0.0)) )</span>
<a name="ln-3413"></a><span class="c">!!       write(*,&#39;(a)&#39;)pr</span>
<a name="ln-3414"></a><span class="c">!!</span>
<a name="ln-3415"></a><span class="c">!!       ! create a format on the fly</span>
<a name="ln-3416"></a><span class="c">!!       biggest=huge(0)</span>
<a name="ln-3417"></a><span class="c">!!       frmt=str(&#39;(*(i&#39;,int(log10(real(biggest))),&#39;:,1x))&#39;,sep=&#39; &#39;)</span>
<a name="ln-3418"></a><span class="c">!!       write(*,*)&#39;format=&#39;,frmt</span>
<a name="ln-3419"></a><span class="c">!!</span>
<a name="ln-3420"></a><span class="c">!!       ! although it will often work, using str(3f) in an I/O statement</span>
<a name="ln-3421"></a><span class="c">!!       ! is not recommended because if an error occurs str(3f) will try</span>
<a name="ln-3422"></a><span class="c">!!       ! to write while part of an I/O statement which not all compilers</span>
<a name="ln-3423"></a><span class="c">!!       ! can handle and is currently non-standard</span>
<a name="ln-3424"></a><span class="c">!!       write(*,*)str(&#39;program will now stop&#39;)</span>
<a name="ln-3425"></a><span class="c">!!</span>
<a name="ln-3426"></a><span class="c">!!       end program demo_msg</span>
<a name="ln-3427"></a><span class="c">!!</span>
<a name="ln-3428"></a><span class="c">!!  Output</span>
<a name="ln-3429"></a><span class="c">!!</span>
<a name="ln-3430"></a><span class="c">!!     HUGE(3f) integers 2147483647 and real 3.40282347E+38 and</span>
<a name="ln-3431"></a><span class="c">!!     double 1.7976931348623157E+308</span>
<a name="ln-3432"></a><span class="c">!!     real            : 3.40282347E+38 0.00000000 12345.6787 1.17549435E-38</span>
<a name="ln-3433"></a><span class="c">!!     doubleprecision : 1.7976931348623157E+308 0.0000000000000000</span>
<a name="ln-3434"></a><span class="c">!!     12345.678900000001 2.2250738585072014E-308</span>
<a name="ln-3435"></a><span class="c">!!     complex         : (3.40282347E+38,1.17549435E-38)</span>
<a name="ln-3436"></a><span class="c">!!      format=(*(i9:,1x))</span>
<a name="ln-3437"></a><span class="c">!!      program will now stop</span>
<a name="ln-3438"></a><span class="c">!!</span>
<a name="ln-3439"></a><span class="c">!!##AUTHOR</span>
<a name="ln-3440"></a><span class="c">!!    John S. Urban</span>
<a name="ln-3441"></a><span class="c">!!##LICENSE</span>
<a name="ln-3442"></a><span class="c">!!    Public Domain</span>
<a name="ln-3443"></a><span class="k">function </span><span class="n">msg_scalar</span><span class="p">(</span><span class="n">generic0</span><span class="p">,</span> <span class="n">generic1</span><span class="p">,</span> <span class="n">generic2</span><span class="p">,</span> <span class="n">generic3</span><span class="p">,</span> <span class="n">generic4</span><span class="p">,</span> <span class="n">generic5</span><span class="p">,</span> <span class="n">generic6</span><span class="p">,</span> <span class="n">generic7</span><span class="p">,</span> <span class="n">generic8</span><span class="p">,</span> <span class="n">generic9</span><span class="p">,</span> <span class="p">&amp;</span>
<a name="ln-3444"></a>                  <span class="p">&amp;</span> <span class="n">generica</span><span class="p">,</span> <span class="n">genericb</span><span class="p">,</span> <span class="n">genericc</span><span class="p">,</span> <span class="n">genericd</span><span class="p">,</span> <span class="n">generice</span><span class="p">,</span> <span class="n">genericf</span><span class="p">,</span> <span class="n">genericg</span><span class="p">,</span> <span class="n">generich</span><span class="p">,</span> <span class="n">generici</span><span class="p">,</span> <span class="n">genericj</span><span class="p">,</span> <span class="p">&amp;</span>
<a name="ln-3445"></a>                  <span class="p">&amp;</span> <span class="n">sep</span><span class="p">)</span>
<a name="ln-3446"></a><span class="k">implicit none</span>
<a name="ln-3447"></a>
<a name="ln-3448"></a><span class="c">! ident_14=&quot;@(#)M_CLI2::msg_scalar(3fp): writes a message to a string composed of any standard scalar types&quot;</span>
<a name="ln-3449"></a>
<a name="ln-3450"></a><span class="k">class</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>  <span class="kd">::</span> <span class="n">generic0</span><span class="p">,</span> <span class="n">generic1</span><span class="p">,</span> <span class="n">generic2</span><span class="p">,</span> <span class="n">generic3</span><span class="p">,</span> <span class="n">generic4</span>
<a name="ln-3451"></a><span class="k">class</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>  <span class="kd">::</span> <span class="n">generic5</span><span class="p">,</span> <span class="n">generic6</span><span class="p">,</span> <span class="n">generic7</span><span class="p">,</span> <span class="n">generic8</span><span class="p">,</span> <span class="n">generic9</span>
<a name="ln-3452"></a><span class="k">class</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>  <span class="kd">::</span> <span class="n">generica</span><span class="p">,</span> <span class="n">genericb</span><span class="p">,</span> <span class="n">genericc</span><span class="p">,</span> <span class="n">genericd</span><span class="p">,</span> <span class="n">generice</span>
<a name="ln-3453"></a><span class="k">class</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>  <span class="kd">::</span> <span class="n">genericf</span><span class="p">,</span> <span class="n">genericg</span><span class="p">,</span> <span class="n">generich</span><span class="p">,</span> <span class="n">generici</span><span class="p">,</span> <span class="n">genericj</span>
<a name="ln-3454"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">sep</span>
<a name="ln-3455"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>  <span class="kd">::</span> <span class="n">sep_local</span>
<a name="ln-3456"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span> <span class="k">allocatable</span> <span class="kd">::</span> <span class="n">msg_scalar</span>
<a name="ln-3457"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">4096</span><span class="p">)</span>           <span class="kd">::</span> <span class="n">line</span>
<a name="ln-3458"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">istart</span>
<a name="ln-3459"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">increment</span>
<a name="ln-3460"></a>   <span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;:MSG_SCALAR&#39;</span>
<a name="ln-3461"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">sep</span><span class="p">))</span><span class="k">then</span>
<a name="ln-3462"></a><span class="k">      </span><span class="n">sep_local</span><span class="o">=</span><span class="n">sep</span>
<a name="ln-3463"></a>      <span class="n">increment</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">sep_local</span><span class="p">)</span><span class="o">+</span><span class="mi">1</span>
<a name="ln-3464"></a>   <span class="k">else</span>
<a name="ln-3465"></a><span class="k">      </span><span class="n">sep_local</span><span class="o">=</span><span class="s1">&#39; &#39;</span>
<a name="ln-3466"></a>      <span class="n">increment</span><span class="o">=</span><span class="mi">2</span>
<a name="ln-3467"></a>   <span class="k">endif</span>
<a name="ln-3468"></a><span class="k">   if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;:MSG_SCALAR&#39;</span>
<a name="ln-3469"></a>
<a name="ln-3470"></a>   <span class="n">istart</span><span class="o">=</span><span class="mi">1</span>
<a name="ln-3471"></a>   <span class="n">line</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-3472"></a>   <span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;:MSG_SCALAR:CALL GENERIC:GENERIC0&#39;</span>
<a name="ln-3473"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generic0</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generic0</span><span class="p">)</span>
<a name="ln-3474"></a>   <span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;:MSG_SCALAR:CALL GENERIC:GENERIC1&#39;</span>
<a name="ln-3475"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generic1</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generic1</span><span class="p">)</span>
<a name="ln-3476"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generic2</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generic2</span><span class="p">)</span>
<a name="ln-3477"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generic3</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generic3</span><span class="p">)</span>
<a name="ln-3478"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generic4</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generic4</span><span class="p">)</span>
<a name="ln-3479"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generic5</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generic5</span><span class="p">)</span>
<a name="ln-3480"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generic6</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generic6</span><span class="p">)</span>
<a name="ln-3481"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generic7</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generic7</span><span class="p">)</span>
<a name="ln-3482"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generic8</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generic8</span><span class="p">)</span>
<a name="ln-3483"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generic9</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generic9</span><span class="p">)</span>
<a name="ln-3484"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generica</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generica</span><span class="p">)</span>
<a name="ln-3485"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">genericb</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">genericb</span><span class="p">)</span>
<a name="ln-3486"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">genericc</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">genericc</span><span class="p">)</span>
<a name="ln-3487"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">genericd</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">genericd</span><span class="p">)</span>
<a name="ln-3488"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generice</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generice</span><span class="p">)</span>
<a name="ln-3489"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">genericf</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">genericf</span><span class="p">)</span>
<a name="ln-3490"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">genericg</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">genericg</span><span class="p">)</span>
<a name="ln-3491"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generich</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generich</span><span class="p">)</span>
<a name="ln-3492"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generici</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generici</span><span class="p">)</span>
<a name="ln-3493"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">genericj</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">genericj</span><span class="p">)</span>
<a name="ln-3494"></a>   <span class="n">msg_scalar</span><span class="o">=</span><span class="nb">trim</span><span class="p">(</span><span class="n">line</span><span class="p">)</span>
<a name="ln-3495"></a><span class="k">contains</span>
<a name="ln-3496"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3497"></a><span class="k">subroutine </span><span class="n">print_generic</span><span class="p">(</span><span class="k">generic</span><span class="p">)</span>
<a name="ln-3498"></a><span class="k">use</span><span class="p">,</span><span class="k">intrinsic</span> <span class="kd">::</span> <span class="n">iso_fortran_env</span><span class="p">,</span> <span class="k">only</span> <span class="p">:</span> <span class="n">int8</span><span class="p">,</span> <span class="n">int16</span><span class="p">,</span> <span class="n">int32</span><span class="p">,</span> <span class="n">int64</span><span class="p">,</span> <span class="n">real32</span><span class="p">,</span> <span class="n">real64</span><span class="p">,</span> <span class="n">real128</span>
<a name="ln-3499"></a><span class="k">class</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="k">generic</span>
<a name="ln-3500"></a><span class="k">   if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;PRINT_GENERIC:START&#39;</span>
<a name="ln-3501"></a>   <span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;PRINT_GENERIC:LINE&#39;</span><span class="p">,</span><span class="nb">trim</span><span class="p">(</span><span class="n">line</span><span class="p">)</span>
<a name="ln-3502"></a>   <span class="k">select type</span><span class="p">(</span><span class="k">generic</span><span class="p">)</span>
<a name="ln-3503"></a>      <span class="k">type is</span> <span class="p">(</span><span class="kt">integer</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">int8</span><span class="p">));</span>     <span class="k">write</span><span class="p">(</span><span class="n">line</span><span class="p">(</span><span class="n">istart</span><span class="p">:),</span><span class="s1">&#39;(i0)&#39;</span><span class="p">)</span> <span class="k">generic</span>
<a name="ln-3504"></a><span class="k">      type is</span> <span class="p">(</span><span class="kt">integer</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">int16</span><span class="p">));</span>    <span class="k">write</span><span class="p">(</span><span class="n">line</span><span class="p">(</span><span class="n">istart</span><span class="p">:),</span><span class="s1">&#39;(i0)&#39;</span><span class="p">)</span> <span class="k">generic</span>
<a name="ln-3505"></a><span class="k">      type is</span> <span class="p">(</span><span class="kt">integer</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">int32</span><span class="p">));</span>    <span class="k">write</span><span class="p">(</span><span class="n">line</span><span class="p">(</span><span class="n">istart</span><span class="p">:),</span><span class="s1">&#39;(i0)&#39;</span><span class="p">)</span> <span class="k">generic</span>
<a name="ln-3506"></a><span class="k">      type is</span> <span class="p">(</span><span class="kt">integer</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">int64</span><span class="p">));</span>    <span class="k">write</span><span class="p">(</span><span class="n">line</span><span class="p">(</span><span class="n">istart</span><span class="p">:),</span><span class="s1">&#39;(i0)&#39;</span><span class="p">)</span> <span class="k">generic</span>
<a name="ln-3507"></a><span class="k">      type is</span> <span class="p">(</span><span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">real32</span><span class="p">));</span>      <span class="k">write</span><span class="p">(</span><span class="n">line</span><span class="p">(</span><span class="n">istart</span><span class="p">:),</span><span class="s1">&#39;(1pg0)&#39;</span><span class="p">)</span> <span class="k">generic</span>
<a name="ln-3508"></a><span class="k">      type is</span> <span class="p">(</span><span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">real64</span><span class="p">))</span>
<a name="ln-3509"></a>         <span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;PRINT_GENERIC:REAL64&#39;</span>
<a name="ln-3510"></a>         <span class="k">write</span><span class="p">(</span><span class="n">line</span><span class="p">(</span><span class="n">istart</span><span class="p">:),</span><span class="s1">&#39;(1pg0)&#39;</span><span class="p">)</span> <span class="k">generic</span>
<a name="ln-3511"></a>      <span class="c">!x! DOES NOT WORK WITH NVFORTRAN: type is (real(kind=real128));     write(line(istart:),&#39;(1pg0)&#39;) generic</span>
<a name="ln-3512"></a>      <span class="k">type is</span> <span class="p">(</span><span class="kt">logical</span><span class="p">)</span>
<a name="ln-3513"></a>         <span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;PRINT_GENERIC:REAL64&#39;</span>
<a name="ln-3514"></a>         <span class="k">write</span><span class="p">(</span><span class="n">line</span><span class="p">(</span><span class="n">istart</span><span class="p">:),</span><span class="s1">&#39;(l1)&#39;</span><span class="p">)</span> <span class="k">generic</span>
<a name="ln-3515"></a><span class="k">      type is</span> <span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">))</span>
<a name="ln-3516"></a>         <span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;PRINT_GENERIC:CHARACTER&#39;</span>
<a name="ln-3517"></a>         <span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;PRINT_GENERIC:ISTART:&#39;</span><span class="p">,</span><span class="n">istart</span>
<a name="ln-3518"></a>         <span class="k">write</span><span class="p">(</span><span class="n">line</span><span class="p">(</span><span class="n">istart</span><span class="p">:),</span><span class="s1">&#39;(a)&#39;</span><span class="p">)</span> <span class="nb">trim</span><span class="p">(</span><span class="k">generic</span><span class="p">)</span>
<a name="ln-3519"></a>      <span class="k">type is</span> <span class="p">(</span><span class="kt">complex</span><span class="p">);</span>                <span class="k">write</span><span class="p">(</span><span class="n">line</span><span class="p">(</span><span class="n">istart</span><span class="p">:),</span><span class="s1">&#39;(&quot;(&quot;,1pg0,&quot;,&quot;,1pg0,&quot;)&quot;)&#39;</span><span class="p">)</span> <span class="k">generic</span>
<a name="ln-3520"></a><span class="k">   end select</span>
<a name="ln-3521"></a><span class="k">   if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;PRINT_GENERIC:START&#39;</span>
<a name="ln-3522"></a>   <span class="n">istart</span><span class="o">=</span><span class="nb">len_trim</span><span class="p">(</span><span class="n">line</span><span class="p">)</span><span class="o">+</span><span class="n">increment</span>
<a name="ln-3523"></a>   <span class="n">line</span><span class="o">=</span><span class="nb">trim</span><span class="p">(</span><span class="n">line</span><span class="p">)</span><span class="o">//</span><span class="n">sep_local</span>
<a name="ln-3524"></a><span class="k">end subroutine </span><span class="n">print_generic</span>
<a name="ln-3525"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3526"></a><span class="k">end function </span><span class="n">msg_scalar</span>
<a name="ln-3527"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3528"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-3529"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3530"></a><span class="k">function </span><span class="n">msg_one</span><span class="p">(</span><span class="n">generic0</span><span class="p">,</span><span class="n">generic1</span><span class="p">,</span> <span class="n">generic2</span><span class="p">,</span> <span class="n">generic3</span><span class="p">,</span> <span class="n">generic4</span><span class="p">,</span> <span class="n">generic5</span><span class="p">,</span> <span class="n">generic6</span><span class="p">,</span> <span class="n">generic7</span><span class="p">,</span> <span class="n">generic8</span><span class="p">,</span> <span class="n">generic9</span><span class="p">,</span><span class="n">sep</span><span class="p">)</span>
<a name="ln-3531"></a><span class="k">implicit none</span>
<a name="ln-3532"></a>
<a name="ln-3533"></a><span class="c">! ident_15=&quot;@(#)M_CLI2::msg_one(3fp): writes a message to a string composed of any standard one dimensional types&quot;</span>
<a name="ln-3534"></a>
<a name="ln-3535"></a><span class="k">class</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>           <span class="kd">::</span> <span class="n">generic0</span><span class="p">(:)</span>
<a name="ln-3536"></a><span class="k">class</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>  <span class="kd">::</span> <span class="n">generic1</span><span class="p">(:),</span> <span class="n">generic2</span><span class="p">(:),</span> <span class="n">generic3</span><span class="p">(:),</span> <span class="n">generic4</span><span class="p">(:),</span> <span class="n">generic5</span><span class="p">(:)</span>
<a name="ln-3537"></a><span class="k">class</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>  <span class="kd">::</span> <span class="n">generic6</span><span class="p">(:),</span> <span class="n">generic7</span><span class="p">(:),</span> <span class="n">generic8</span><span class="p">(:),</span> <span class="n">generic9</span><span class="p">(:)</span>
<a name="ln-3538"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">sep</span>
<a name="ln-3539"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>  <span class="kd">::</span> <span class="n">sep_local</span>
<a name="ln-3540"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span> <span class="k">allocatable</span> <span class="kd">::</span> <span class="n">msg_one</span>
<a name="ln-3541"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">4096</span><span class="p">)</span>           <span class="kd">::</span> <span class="n">line</span>
<a name="ln-3542"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">istart</span>
<a name="ln-3543"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">increment</span>
<a name="ln-3544"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">sep</span><span class="p">))</span><span class="k">then</span>
<a name="ln-3545"></a><span class="k">      </span><span class="n">sep_local</span><span class="o">=</span><span class="n">sep</span>
<a name="ln-3546"></a>      <span class="n">increment</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">sep_local</span><span class="p">)</span><span class="o">+</span><span class="mi">1</span>
<a name="ln-3547"></a>   <span class="k">else</span>
<a name="ln-3548"></a><span class="k">      </span><span class="n">sep_local</span><span class="o">=</span><span class="s1">&#39; &#39;</span>
<a name="ln-3549"></a>      <span class="n">increment</span><span class="o">=</span><span class="mi">2</span>
<a name="ln-3550"></a>   <span class="k">endif</span>
<a name="ln-3551"></a>
<a name="ln-3552"></a><span class="k">   </span><span class="n">istart</span><span class="o">=</span><span class="mi">1</span>
<a name="ln-3553"></a>   <span class="n">line</span><span class="o">=</span><span class="s1">&#39; &#39;</span>
<a name="ln-3554"></a>   <span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generic0</span><span class="p">)</span>
<a name="ln-3555"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generic1</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generic1</span><span class="p">)</span>
<a name="ln-3556"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generic2</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generic2</span><span class="p">)</span>
<a name="ln-3557"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generic3</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generic3</span><span class="p">)</span>
<a name="ln-3558"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generic4</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generic4</span><span class="p">)</span>
<a name="ln-3559"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generic5</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generic5</span><span class="p">)</span>
<a name="ln-3560"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generic6</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generic6</span><span class="p">)</span>
<a name="ln-3561"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generic7</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generic7</span><span class="p">)</span>
<a name="ln-3562"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generic8</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generic8</span><span class="p">)</span>
<a name="ln-3563"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">generic9</span><span class="p">))</span><span class="k">call </span><span class="n">print_generic</span><span class="p">(</span><span class="n">generic9</span><span class="p">)</span>
<a name="ln-3564"></a>   <span class="n">msg_one</span><span class="o">=</span><span class="nb">trim</span><span class="p">(</span><span class="n">line</span><span class="p">)</span>
<a name="ln-3565"></a><span class="k">contains</span>
<a name="ln-3566"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3567"></a><span class="k">subroutine </span><span class="n">print_generic</span><span class="p">(</span><span class="k">generic</span><span class="p">)</span>
<a name="ln-3568"></a><span class="k">use</span><span class="p">,</span><span class="k">intrinsic</span> <span class="kd">::</span> <span class="n">iso_fortran_env</span><span class="p">,</span> <span class="k">only</span> <span class="p">:</span> <span class="n">int8</span><span class="p">,</span> <span class="n">int16</span><span class="p">,</span> <span class="n">int32</span><span class="p">,</span> <span class="n">int64</span><span class="p">,</span> <span class="n">real32</span><span class="p">,</span> <span class="n">real64</span><span class="p">,</span> <span class="n">real128</span>
<a name="ln-3569"></a><span class="k">class</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="k">generic</span><span class="p">(:)</span>
<a name="ln-3570"></a><span class="kt">integer</span> <span class="kd">::</span> <span class="n">i</span>
<a name="ln-3571"></a>   <span class="k">select type</span><span class="p">(</span><span class="k">generic</span><span class="p">)</span>
<a name="ln-3572"></a>      <span class="k">type is</span> <span class="p">(</span><span class="kt">integer</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">int8</span><span class="p">));</span>     <span class="k">write</span><span class="p">(</span><span class="n">line</span><span class="p">(</span><span class="n">istart</span><span class="p">:),</span><span class="s1">&#39;(&quot;[&quot;,*(i0,1x))&#39;</span><span class="p">)</span> <span class="k">generic</span>
<a name="ln-3573"></a><span class="k">      type is</span> <span class="p">(</span><span class="kt">integer</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">int16</span><span class="p">));</span>    <span class="k">write</span><span class="p">(</span><span class="n">line</span><span class="p">(</span><span class="n">istart</span><span class="p">:),</span><span class="s1">&#39;(&quot;[&quot;,*(i0,1x))&#39;</span><span class="p">)</span> <span class="k">generic</span>
<a name="ln-3574"></a><span class="k">      type is</span> <span class="p">(</span><span class="kt">integer</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">int32</span><span class="p">));</span>    <span class="k">write</span><span class="p">(</span><span class="n">line</span><span class="p">(</span><span class="n">istart</span><span class="p">:),</span><span class="s1">&#39;(&quot;[&quot;,*(i0,1x))&#39;</span><span class="p">)</span> <span class="k">generic</span>
<a name="ln-3575"></a><span class="k">      type is</span> <span class="p">(</span><span class="kt">integer</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">int64</span><span class="p">));</span>    <span class="k">write</span><span class="p">(</span><span class="n">line</span><span class="p">(</span><span class="n">istart</span><span class="p">:),</span><span class="s1">&#39;(&quot;[&quot;,*(i0,1x))&#39;</span><span class="p">)</span> <span class="k">generic</span>
<a name="ln-3576"></a><span class="k">      type is</span> <span class="p">(</span><span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">real32</span><span class="p">));</span>      <span class="k">write</span><span class="p">(</span><span class="n">line</span><span class="p">(</span><span class="n">istart</span><span class="p">:),</span><span class="s1">&#39;(&quot;[&quot;,*(1pg0,1x))&#39;</span><span class="p">)</span> <span class="k">generic</span>
<a name="ln-3577"></a><span class="k">      type is</span> <span class="p">(</span><span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">real64</span><span class="p">));</span>      <span class="k">write</span><span class="p">(</span><span class="n">line</span><span class="p">(</span><span class="n">istart</span><span class="p">:),</span><span class="s1">&#39;(&quot;[&quot;,*(1pg0,1x))&#39;</span><span class="p">)</span> <span class="k">generic</span>
<a name="ln-3578"></a>      <span class="c">!x! DOES NOT WORK WITH nvfortran: type is (real(kind=real128));     write(line(istart:),&#39;(&quot;[&quot;,*(1pg0,1x))&#39;) generic</span>
<a name="ln-3579"></a>      <span class="c">!x! DOES NOT WORK WITH ifort:     type is (real(kind=real256));     write(error_unit,&#39;(1pg0)&#39;,advance=&#39;no&#39;) generic</span>
<a name="ln-3580"></a>      <span class="k">type is</span> <span class="p">(</span><span class="kt">logical</span><span class="p">);</span>                <span class="k">write</span><span class="p">(</span><span class="n">line</span><span class="p">(</span><span class="n">istart</span><span class="p">:),</span><span class="s1">&#39;(&quot;[&quot;,*(l1,1x))&#39;</span><span class="p">)</span> <span class="k">generic</span>
<a name="ln-3581"></a><span class="k">      type is</span> <span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">))</span>
<a name="ln-3582"></a>         <span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;PRINT_GENERIC:CHARACTER&#39;</span>
<a name="ln-3583"></a>         <span class="k">if</span><span class="p">(</span><span class="n">debug_m_cli2</span><span class="p">)</span><span class="k">write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="n">gen</span><span class="p">)</span><span class="s1">&#39;&lt;DEBUG&gt;PRINT_GENERIC:ISTART:&#39;</span><span class="p">,</span><span class="n">istart</span>
<a name="ln-3584"></a>         <span class="k">write</span><span class="p">(</span><span class="n">line</span><span class="p">(</span><span class="n">istart</span><span class="p">:),</span><span class="s1">&#39;(&quot;[&quot;,:*(&quot;&quot;&quot;&quot;,a,&quot;&quot;&quot;&quot;,1x))&#39;</span><span class="p">)</span> <span class="p">(</span><span class="nb">trim</span><span class="p">(</span><span class="k">generic</span><span class="p">(</span><span class="n">i</span><span class="p">)),</span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="k">generic</span><span class="p">))</span>
<a name="ln-3585"></a>      <span class="k">type is</span> <span class="p">(</span><span class="kt">complex</span><span class="p">);</span>                <span class="k">write</span><span class="p">(</span><span class="n">line</span><span class="p">(</span><span class="n">istart</span><span class="p">:),</span><span class="s1">&#39;(&quot;[&quot;,*(&quot;(&quot;,1pg0,&quot;,&quot;,1pg0,&quot;)&quot;,1x))&#39;</span><span class="p">)</span> <span class="k">generic</span>
<a name="ln-3586"></a><span class="k">      class </span><span class="n">default</span>
<a name="ln-3587"></a>         <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="o">-</span><span class="mi">22</span><span class="p">,</span><span class="s1">&#39;unknown type in *print_generic*&#39;</span><span class="p">)</span>
<a name="ln-3588"></a>   <span class="k">end select</span>
<a name="ln-3589"></a><span class="k">   </span><span class="n">istart</span><span class="o">=</span><span class="nb">len_trim</span><span class="p">(</span><span class="n">line</span><span class="p">)</span><span class="o">+</span><span class="n">increment</span><span class="o">+</span><span class="mi">1</span>
<a name="ln-3590"></a>   <span class="n">line</span><span class="o">=</span><span class="nb">trim</span><span class="p">(</span><span class="n">line</span><span class="p">)</span><span class="o">//</span><span class="s2">&quot;]&quot;</span><span class="o">//</span><span class="n">sep_local</span>
<a name="ln-3591"></a><span class="k">end subroutine </span><span class="n">print_generic</span>
<a name="ln-3592"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3593"></a><span class="k">end function </span><span class="n">msg_one</span>
<a name="ln-3594"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3595"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-3596"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3597"></a><span class="k">function </span><span class="n">upper</span><span class="p">(</span><span class="n">str</span><span class="p">)</span> <span class="k">result</span> <span class="p">(</span><span class="n">string</span><span class="p">)</span>
<a name="ln-3598"></a>
<a name="ln-3599"></a><span class="c">! ident_16=&quot;@(#)M_CLI2::upper(3f): Changes a string to uppercase&quot;</span>
<a name="ln-3600"></a>
<a name="ln-3601"></a><span class="kt">character</span><span class="p">(</span><span class="o">*</span><span class="p">),</span> <span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>      <span class="kd">::</span> <span class="n">str</span>
<a name="ln-3602"></a><span class="kt">character</span><span class="p">(:),</span><span class="k">allocatable</span>      <span class="kd">::</span> <span class="n">string</span>
<a name="ln-3603"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">i</span>
<a name="ln-3604"></a>   <span class="n">string</span> <span class="o">=</span> <span class="n">str</span>
<a name="ln-3605"></a>   <span class="k">do </span><span class="n">i</span> <span class="o">=</span> <span class="mi">1</span><span class="p">,</span> <span class="nb">len_trim</span><span class="p">(</span><span class="n">str</span><span class="p">)</span>
<a name="ln-3606"></a>       <span class="k">select case</span> <span class="p">(</span><span class="n">str</span><span class="p">(</span><span class="n">i</span><span class="p">:</span><span class="n">i</span><span class="p">))</span>
<a name="ln-3607"></a>       <span class="k">case</span> <span class="p">(</span><span class="s1">&#39;a&#39;</span><span class="p">:</span><span class="s1">&#39;z&#39;</span><span class="p">)</span>
<a name="ln-3608"></a>          <span class="n">string</span><span class="p">(</span><span class="n">i</span><span class="p">:</span><span class="n">i</span><span class="p">)</span> <span class="o">=</span> <span class="nb">char</span><span class="p">(</span><span class="nb">iachar</span><span class="p">(</span><span class="n">str</span><span class="p">(</span><span class="n">i</span><span class="p">:</span><span class="n">i</span><span class="p">))</span><span class="o">-</span><span class="mi">32</span><span class="p">)</span>
<a name="ln-3609"></a>       <span class="k">end select</span>
<a name="ln-3610"></a><span class="k">   end do</span>
<a name="ln-3611"></a><span class="k">end function </span><span class="n">upper</span>
<a name="ln-3612"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3613"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-3614"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3615"></a><span class="k">function </span><span class="n">lower</span><span class="p">(</span><span class="n">str</span><span class="p">)</span> <span class="k">result</span> <span class="p">(</span><span class="n">string</span><span class="p">)</span>
<a name="ln-3616"></a>
<a name="ln-3617"></a><span class="c">! ident_17=&quot;@(#)M_CLI2::lower(3f): Changes a string to lowercase over specified range&quot;</span>
<a name="ln-3618"></a>
<a name="ln-3619"></a><span class="kt">character</span><span class="p">(</span><span class="o">*</span><span class="p">),</span> <span class="k">intent</span><span class="p">(</span><span class="n">In</span><span class="p">)</span>     <span class="kd">::</span> <span class="n">str</span>
<a name="ln-3620"></a><span class="kt">character</span><span class="p">(:),</span><span class="k">allocatable</span>     <span class="kd">::</span> <span class="n">string</span>
<a name="ln-3621"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">i</span>
<a name="ln-3622"></a>   <span class="n">string</span> <span class="o">=</span> <span class="n">str</span>
<a name="ln-3623"></a>   <span class="k">do </span><span class="n">i</span> <span class="o">=</span> <span class="mi">1</span><span class="p">,</span> <span class="nb">len_trim</span><span class="p">(</span><span class="n">str</span><span class="p">)</span>
<a name="ln-3624"></a>      <span class="k">select case</span> <span class="p">(</span><span class="n">str</span><span class="p">(</span><span class="n">i</span><span class="p">:</span><span class="n">i</span><span class="p">))</span>
<a name="ln-3625"></a>      <span class="k">case</span> <span class="p">(</span><span class="s1">&#39;A&#39;</span><span class="p">:</span><span class="s1">&#39;Z&#39;</span><span class="p">)</span>
<a name="ln-3626"></a>         <span class="n">string</span><span class="p">(</span><span class="n">i</span><span class="p">:</span><span class="n">i</span><span class="p">)</span> <span class="o">=</span> <span class="nb">char</span><span class="p">(</span><span class="nb">iachar</span><span class="p">(</span><span class="n">str</span><span class="p">(</span><span class="n">i</span><span class="p">:</span><span class="n">i</span><span class="p">))</span><span class="o">+</span><span class="mi">32</span><span class="p">)</span>
<a name="ln-3627"></a>      <span class="k">end select</span>
<a name="ln-3628"></a><span class="k">   end do</span>
<a name="ln-3629"></a><span class="k">end function </span><span class="n">lower</span>
<a name="ln-3630"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3631"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-3632"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3633"></a><span class="k">subroutine </span><span class="n">a2i</span><span class="p">(</span><span class="n">chars</span><span class="p">,</span><span class="n">valu</span><span class="p">,</span><span class="n">ierr</span><span class="p">)</span>
<a name="ln-3634"></a>
<a name="ln-3635"></a><span class="c">! ident_18=&quot;@(#)M_CLI2::a2i(3fp): subroutine returns integer value from string&quot;</span>
<a name="ln-3636"></a>
<a name="ln-3637"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">chars</span>                      <span class="c">! input string</span>
<a name="ln-3638"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span>         <span class="kd">::</span> <span class="n">valu</span>                       <span class="c">! value read from input string</span>
<a name="ln-3639"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span>         <span class="kd">::</span> <span class="n">ierr</span>                       <span class="c">! error flag (0 == no error)</span>
<a name="ln-3640"></a><span class="n">doubleprecision</span>             <span class="kd">::</span> <span class="n">valu8</span>
<a name="ln-3641"></a>   <span class="n">valu8</span><span class="o">=</span><span class="mf">0.0d0</span>
<a name="ln-3642"></a>   <span class="k">call </span><span class="n">a2d</span><span class="p">(</span><span class="n">chars</span><span class="p">,</span><span class="n">valu8</span><span class="p">,</span><span class="n">ierr</span><span class="p">,</span><span class="n">onerr</span><span class="o">=</span><span class="mf">0.0d0</span><span class="p">)</span>
<a name="ln-3643"></a>   <span class="k">if</span><span class="p">(</span><span class="n">valu8</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="nb">huge</span><span class="p">(</span><span class="n">valu</span><span class="p">))</span><span class="k">then</span>
<a name="ln-3644"></a><span class="k">      if</span><span class="p">(</span><span class="n">valu8</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="nb">huge</span><span class="p">(</span><span class="n">valu</span><span class="p">))</span><span class="k">then</span>
<a name="ln-3645"></a><span class="k">         </span><span class="n">valu</span><span class="o">=</span><span class="nb">int</span><span class="p">(</span><span class="n">valu8</span><span class="p">)</span>
<a name="ln-3646"></a>      <span class="k">else</span>
<a name="ln-3647"></a><span class="k">         call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*a2i*&#39;</span><span class="p">,</span><span class="s1">&#39;- value too large&#39;</span><span class="p">,</span><span class="n">valu8</span><span class="p">,</span><span class="s1">&#39;&gt;&#39;</span><span class="p">,</span><span class="nb">huge</span><span class="p">(</span><span class="n">valu</span><span class="p">))</span>
<a name="ln-3648"></a>         <span class="n">valu</span><span class="o">=</span><span class="nb">huge</span><span class="p">(</span><span class="n">valu</span><span class="p">)</span>
<a name="ln-3649"></a>         <span class="n">ierr</span><span class="o">=-</span><span class="mi">1</span>
<a name="ln-3650"></a>      <span class="k">endif</span>
<a name="ln-3651"></a><span class="k">   endif</span>
<a name="ln-3652"></a><span class="k">end subroutine </span><span class="n">a2i</span>
<a name="ln-3653"></a><span class="c">!----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-3654"></a><span class="k">subroutine </span><span class="n">a2d</span><span class="p">(</span><span class="n">chars</span><span class="p">,</span><span class="n">valu</span><span class="p">,</span><span class="n">ierr</span><span class="p">,</span><span class="n">onerr</span><span class="p">)</span>
<a name="ln-3655"></a>
<a name="ln-3656"></a><span class="c">! ident_19=&quot;@(#)M_CLI2::a2d(3fp): subroutine returns double value from string&quot;</span>
<a name="ln-3657"></a>
<a name="ln-3658"></a><span class="c">!     1989,2016 John S. Urban.</span>
<a name="ln-3659"></a><span class="c">!</span>
<a name="ln-3660"></a><span class="c">!  o  works with any g-format input, including integer, real, and exponential.</span>
<a name="ln-3661"></a><span class="c">!  o  if an error occurs in the read, iostat is returned in ierr and value is set to zero. If no error occurs, ierr=0.</span>
<a name="ln-3662"></a><span class="c">!  o  if the string happens to be &#39;eod&#39; no error message is produced so this string may be used to act as an end-of-data.</span>
<a name="ln-3663"></a><span class="c">!     IERR will still be non-zero in this case.</span>
<a name="ln-3664"></a><span class="c">!----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-3665"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>  <span class="kd">::</span> <span class="n">chars</span>                        <span class="c">! input string</span>
<a name="ln-3666"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">local_chars</span>
<a name="ln-3667"></a><span class="n">doubleprecision</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span>  <span class="kd">::</span> <span class="n">valu</span>                         <span class="c">! value read from input string</span>
<a name="ln-3668"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">ierr</span>                         <span class="c">! error flag (0 == no error)</span>
<a name="ln-3669"></a><span class="k">class</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="k">optional</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">onerr</span>
<a name="ln-3670"></a><span class="c">!----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-3671"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">parameter</span>   <span class="kd">::</span> <span class="n">fmt</span><span class="o">=</span><span class="s2">&quot;(&#39;(bn,g&#39;,i5,&#39;.0)&#39;)&quot;</span>     <span class="c">! format used to build frmt</span>
<a name="ln-3672"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">15</span><span class="p">)</span>            <span class="kd">::</span> <span class="n">frmt</span>                         <span class="c">! holds format built to read input string</span>
<a name="ln-3673"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">256</span><span class="p">)</span>           <span class="kd">::</span> <span class="n">msg</span>                          <span class="c">! hold message from I/O errors</span>
<a name="ln-3674"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">intg</span>
<a name="ln-3675"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">pnd</span>
<a name="ln-3676"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">basevalue</span><span class="p">,</span> <span class="n">ivalu</span>
<a name="ln-3677"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">3</span><span class="p">),</span><span class="k">save</span>        <span class="kd">::</span> <span class="n">nan_string</span><span class="o">=</span><span class="s1">&#39;NaN&#39;</span>
<a name="ln-3678"></a><span class="c">!----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-3679"></a>   <span class="n">ierr</span><span class="o">=</span><span class="mi">0</span>                                                       <span class="c">! initialize error flag to zero</span>
<a name="ln-3680"></a>   <span class="n">local_chars</span><span class="o">=</span><span class="n">unquote</span><span class="p">(</span><span class="n">chars</span><span class="p">)</span>
<a name="ln-3681"></a>   <span class="n">msg</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-3682"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">len</span><span class="p">(</span><span class="n">local_chars</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="n">local_chars</span><span class="o">=</span><span class="s1">&#39; &#39;</span>
<a name="ln-3683"></a>   <span class="k">call </span><span class="n">substitute</span><span class="p">(</span><span class="n">local_chars</span><span class="p">,</span><span class="s1">&#39;,&#39;</span><span class="p">,</span><span class="s1">&#39;&#39;</span><span class="p">)</span>                          <span class="c">! remove any comma characters</span>
<a name="ln-3684"></a>   <span class="n">pnd</span><span class="o">=</span><span class="nb">scan</span><span class="p">(</span><span class="n">local_chars</span><span class="p">,</span><span class="s1">&#39;#:&#39;</span><span class="p">)</span>
<a name="ln-3685"></a>   <span class="k">if</span><span class="p">(</span><span class="n">pnd</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-3686"></a><span class="k">      write</span><span class="p">(</span><span class="n">frmt</span><span class="p">,</span><span class="n">fmt</span><span class="p">)</span><span class="n">pnd</span><span class="o">-</span><span class="mi">1</span>                                      <span class="c">! build format of form &#39;(BN,Gn.0)&#39;</span>
<a name="ln-3687"></a>      <span class="k">read</span><span class="p">(</span><span class="n">local_chars</span><span class="p">(:</span><span class="n">pnd</span><span class="o">-</span><span class="mi">1</span><span class="p">),</span><span class="n">fmt</span><span class="o">=</span><span class="n">frmt</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">ierr</span><span class="p">,</span><span class="n">iomsg</span><span class="o">=</span><span class="n">msg</span><span class="p">)</span><span class="n">basevalue</span>   <span class="c">! try to read value from string</span>
<a name="ln-3688"></a>      <span class="k">if</span><span class="p">(</span><span class="n">decodebase</span><span class="p">(</span><span class="n">local_chars</span><span class="p">(</span><span class="n">pnd</span><span class="o">+</span><span class="mi">1</span><span class="p">:),</span><span class="n">basevalue</span><span class="p">,</span><span class="n">ivalu</span><span class="p">))</span><span class="k">then</span>
<a name="ln-3689"></a><span class="k">         </span><span class="n">valu</span><span class="o">=</span><span class="kt">real</span><span class="p">(</span><span class="n">ivalu</span><span class="p">,</span><span class="nb">kind</span><span class="o">=</span><span class="nb">kind</span><span class="p">(</span><span class="mf">0.0d0</span><span class="p">))</span>
<a name="ln-3690"></a>      <span class="k">else</span>
<a name="ln-3691"></a><span class="k">         </span><span class="n">valu</span><span class="o">=</span><span class="mf">0.0d0</span>
<a name="ln-3692"></a>         <span class="n">ierr</span><span class="o">=-</span><span class="mi">1</span>
<a name="ln-3693"></a>      <span class="k">endif</span>
<a name="ln-3694"></a><span class="k">   else</span>
<a name="ln-3695"></a><span class="k">      select case</span><span class="p">(</span><span class="n">local_chars</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="mi">1</span><span class="p">))</span>
<a name="ln-3696"></a>      <span class="k">case</span><span class="p">(</span><span class="s1">&#39;z&#39;</span><span class="p">,</span><span class="s1">&#39;Z&#39;</span><span class="p">,</span><span class="s1">&#39;h&#39;</span><span class="p">,</span><span class="s1">&#39;H&#39;</span><span class="p">)</span>                                     <span class="c">! assume hexadecimal</span>
<a name="ln-3697"></a>         <span class="n">frmt</span><span class="o">=</span><span class="s1">&#39;(Z&#39;</span><span class="o">//</span><span class="n">i2s</span><span class="p">(</span><span class="nb">len</span><span class="p">(</span><span class="n">local_chars</span><span class="p">))</span><span class="o">//</span><span class="s1">&#39;)&#39;</span>
<a name="ln-3698"></a>         <span class="k">read</span><span class="p">(</span><span class="n">local_chars</span><span class="p">(</span><span class="mi">2</span><span class="p">:),</span><span class="n">frmt</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">ierr</span><span class="p">,</span><span class="n">iomsg</span><span class="o">=</span><span class="n">msg</span><span class="p">)</span><span class="n">intg</span>
<a name="ln-3699"></a>         <span class="n">valu</span><span class="o">=</span><span class="nb">dble</span><span class="p">(</span><span class="n">intg</span><span class="p">)</span>
<a name="ln-3700"></a>      <span class="k">case</span><span class="p">(</span><span class="s1">&#39;b&#39;</span><span class="p">,</span><span class="s1">&#39;B&#39;</span><span class="p">)</span>                                             <span class="c">! assume binary (base 2)</span>
<a name="ln-3701"></a>         <span class="n">frmt</span><span class="o">=</span><span class="s1">&#39;(B&#39;</span><span class="o">//</span><span class="n">i2s</span><span class="p">(</span><span class="nb">len</span><span class="p">(</span><span class="n">local_chars</span><span class="p">))</span><span class="o">//</span><span class="s1">&#39;)&#39;</span>
<a name="ln-3702"></a>         <span class="k">read</span><span class="p">(</span><span class="n">local_chars</span><span class="p">(</span><span class="mi">2</span><span class="p">:),</span><span class="n">frmt</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">ierr</span><span class="p">,</span><span class="n">iomsg</span><span class="o">=</span><span class="n">msg</span><span class="p">)</span><span class="n">intg</span>
<a name="ln-3703"></a>         <span class="n">valu</span><span class="o">=</span><span class="nb">dble</span><span class="p">(</span><span class="n">intg</span><span class="p">)</span>
<a name="ln-3704"></a>      <span class="k">case</span><span class="p">(</span><span class="s1">&#39;o&#39;</span><span class="p">,</span><span class="s1">&#39;O&#39;</span><span class="p">)</span>                                             <span class="c">! assume octal</span>
<a name="ln-3705"></a>         <span class="n">frmt</span><span class="o">=</span><span class="s1">&#39;(O&#39;</span><span class="o">//</span><span class="n">i2s</span><span class="p">(</span><span class="nb">len</span><span class="p">(</span><span class="n">local_chars</span><span class="p">))</span><span class="o">//</span><span class="s1">&#39;)&#39;</span>
<a name="ln-3706"></a>         <span class="k">read</span><span class="p">(</span><span class="n">local_chars</span><span class="p">(</span><span class="mi">2</span><span class="p">:),</span><span class="n">frmt</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">ierr</span><span class="p">,</span><span class="n">iomsg</span><span class="o">=</span><span class="n">msg</span><span class="p">)</span><span class="n">intg</span>
<a name="ln-3707"></a>         <span class="n">valu</span><span class="o">=</span><span class="nb">dble</span><span class="p">(</span><span class="n">intg</span><span class="p">)</span>
<a name="ln-3708"></a>      <span class="k">case </span><span class="n">default</span>
<a name="ln-3709"></a>         <span class="k">write</span><span class="p">(</span><span class="n">frmt</span><span class="p">,</span><span class="n">fmt</span><span class="p">)</span><span class="nb">len</span><span class="p">(</span><span class="n">local_chars</span><span class="p">)</span>                        <span class="c">! build format of form &#39;(BN,Gn.0)&#39;</span>
<a name="ln-3710"></a>         <span class="k">read</span><span class="p">(</span><span class="n">local_chars</span><span class="p">,</span><span class="n">fmt</span><span class="o">=</span><span class="n">frmt</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">ierr</span><span class="p">,</span><span class="n">iomsg</span><span class="o">=</span><span class="n">msg</span><span class="p">)</span><span class="n">valu</span>   <span class="c">! try to read value from string</span>
<a name="ln-3711"></a>      <span class="k">end select</span>
<a name="ln-3712"></a><span class="k">   endif</span>
<a name="ln-3713"></a><span class="k">   if</span><span class="p">(</span><span class="n">ierr</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                            <span class="c">! if an error occurred ierr will be non-zero.</span>
<a name="ln-3714"></a>      <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">onerr</span><span class="p">))</span><span class="k">then</span>
<a name="ln-3715"></a><span class="k">         select type</span><span class="p">(</span><span class="n">onerr</span><span class="p">)</span>
<a name="ln-3716"></a>         <span class="k">type is</span> <span class="p">(</span><span class="kt">integer</span><span class="p">)</span>
<a name="ln-3717"></a>            <span class="n">valu</span><span class="o">=</span><span class="n">onerr</span>
<a name="ln-3718"></a>         <span class="k">type is</span> <span class="p">(</span><span class="kt">real</span><span class="p">)</span>
<a name="ln-3719"></a>            <span class="n">valu</span><span class="o">=</span><span class="n">onerr</span>
<a name="ln-3720"></a>         <span class="k">type is</span> <span class="p">(</span><span class="n">doubleprecision</span><span class="p">)</span>
<a name="ln-3721"></a>            <span class="n">valu</span><span class="o">=</span><span class="n">onerr</span>
<a name="ln-3722"></a>         <span class="k">end select</span>
<a name="ln-3723"></a><span class="k">      else</span>                                                      <span class="c">! set return value to NaN</span>
<a name="ln-3724"></a>         <span class="k">read</span><span class="p">(</span><span class="n">nan_string</span><span class="p">,</span><span class="s1">&#39;(g3.3)&#39;</span><span class="p">)</span><span class="n">valu</span>
<a name="ln-3725"></a>      <span class="k">endif</span>
<a name="ln-3726"></a><span class="k">      if</span><span class="p">(</span><span class="n">local_chars</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39;eod&#39;</span><span class="p">)</span><span class="k">then</span>                           <span class="c">! print warning message except for special value &quot;eod&quot;</span>
<a name="ln-3727"></a>         <span class="k">call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*a2d* - cannot produce number from string [&#39;</span><span class="o">//</span><span class="nb">trim</span><span class="p">(</span><span class="n">chars</span><span class="p">)</span><span class="o">//</span><span class="s1">&#39;]&#39;</span><span class="p">)</span>
<a name="ln-3728"></a>         <span class="k">if</span><span class="p">(</span><span class="n">msg</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39;&#39;</span><span class="p">)</span><span class="k">then</span>
<a name="ln-3729"></a><span class="k">            call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*a2d* - [&#39;</span><span class="o">//</span><span class="nb">trim</span><span class="p">(</span><span class="n">msg</span><span class="p">)</span><span class="o">//</span><span class="s1">&#39;]&#39;</span><span class="p">)</span>
<a name="ln-3730"></a>         <span class="k">endif</span>
<a name="ln-3731"></a><span class="k">      endif</span>
<a name="ln-3732"></a><span class="k">   endif</span>
<a name="ln-3733"></a><span class="k">end subroutine </span><span class="n">a2d</span>
<a name="ln-3734"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3735"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-3736"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3737"></a><span class="c">!&gt;</span>
<a name="ln-3738"></a><span class="c">!!##NAME</span>
<a name="ln-3739"></a><span class="c">!!    split(3f) - [M_CLI2:TOKENS] parse string into an array using specified</span>
<a name="ln-3740"></a><span class="c">!!    delimiters</span>
<a name="ln-3741"></a><span class="c">!!    (LICENSE:PD)</span>
<a name="ln-3742"></a><span class="c">!!</span>
<a name="ln-3743"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-3744"></a><span class="c">!!</span>
<a name="ln-3745"></a><span class="c">!!    subroutine split(input_line,array,delimiters,order,nulls)</span>
<a name="ln-3746"></a><span class="c">!!</span>
<a name="ln-3747"></a><span class="c">!!     character(len=*),intent(in)              :: input_line</span>
<a name="ln-3748"></a><span class="c">!!     character(len=:),allocatable,intent(out) :: array(:)</span>
<a name="ln-3749"></a><span class="c">!!     character(len=*),optional,intent(in)     :: delimiters</span>
<a name="ln-3750"></a><span class="c">!!     character(len=*),optional,intent(in)     :: order</span>
<a name="ln-3751"></a><span class="c">!!     character(len=*),optional,intent(in)     :: nulls</span>
<a name="ln-3752"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-3753"></a><span class="c">!!    SPLIT(3f) parses a string using specified delimiter characters and</span>
<a name="ln-3754"></a><span class="c">!!    store tokens into an allocatable array</span>
<a name="ln-3755"></a><span class="c">!!</span>
<a name="ln-3756"></a><span class="c">!!##OPTIONS</span>
<a name="ln-3757"></a><span class="c">!!</span>
<a name="ln-3758"></a><span class="c">!!    INPUT_LINE  Input string to tokenize</span>
<a name="ln-3759"></a><span class="c">!!</span>
<a name="ln-3760"></a><span class="c">!!    ARRAY       Output array of tokens</span>
<a name="ln-3761"></a><span class="c">!!</span>
<a name="ln-3762"></a><span class="c">!!    DELIMITERS  List of delimiter characters.</span>
<a name="ln-3763"></a><span class="c">!!                The default delimiters are the &quot;whitespace&quot; characters</span>
<a name="ln-3764"></a><span class="c">!!                (space, tab,new line, vertical tab, formfeed, carriage</span>
<a name="ln-3765"></a><span class="c">!!                return, and null). You may specify an alternate set of</span>
<a name="ln-3766"></a><span class="c">!!                delimiter characters.</span>
<a name="ln-3767"></a><span class="c">!!</span>
<a name="ln-3768"></a><span class="c">!!                Multi-character delimiters are not supported (Each</span>
<a name="ln-3769"></a><span class="c">!!                character in the DELIMITERS list is considered to be</span>
<a name="ln-3770"></a><span class="c">!!                a delimiter).</span>
<a name="ln-3771"></a><span class="c">!!</span>
<a name="ln-3772"></a><span class="c">!!                Quoting of delimiter characters is not supported.</span>
<a name="ln-3773"></a><span class="c">!!</span>
<a name="ln-3774"></a><span class="c">!!    ORDER SEQUENTIAL|REVERSE|RIGHT  Order of output array.</span>
<a name="ln-3775"></a><span class="c">!!                By default ARRAY contains the tokens having parsed</span>
<a name="ln-3776"></a><span class="c">!!                the INPUT_LINE from left to right. If ORDER=&#39;RIGHT&#39;</span>
<a name="ln-3777"></a><span class="c">!!                or ORDER=&#39;REVERSE&#39; the parsing goes from right to left.</span>
<a name="ln-3778"></a><span class="c">!!</span>
<a name="ln-3779"></a><span class="c">!!    NULLS IGNORE|RETURN|IGNOREEND  Treatment of null fields.</span>
<a name="ln-3780"></a><span class="c">!!                By default adjacent delimiters in the input string</span>
<a name="ln-3781"></a><span class="c">!!                do not create an empty string in the output array. if</span>
<a name="ln-3782"></a><span class="c">!!                NULLS=&#39;return&#39; adjacent delimiters create an empty element</span>
<a name="ln-3783"></a><span class="c">!!                in the output ARRAY. If NULLS=&#39;ignoreend&#39; then only</span>
<a name="ln-3784"></a><span class="c">!!                trailing delimiters at the right of the string are ignored.</span>
<a name="ln-3785"></a><span class="c">!!</span>
<a name="ln-3786"></a><span class="c">!!##EXAMPLES</span>
<a name="ln-3787"></a><span class="c">!!</span>
<a name="ln-3788"></a><span class="c">!! Sample program:</span>
<a name="ln-3789"></a><span class="c">!!</span>
<a name="ln-3790"></a><span class="c">!!     program demo_split</span>
<a name="ln-3791"></a><span class="c">!!     use M_CLI2, only: split</span>
<a name="ln-3792"></a><span class="c">!!     character(len=*),parameter     :: &amp;</span>
<a name="ln-3793"></a><span class="c">!!     &amp; line=&#39;  aBcdef   ghijklmnop qrstuvwxyz  1:|:2     333|333 a B cc    &#39;</span>
<a name="ln-3794"></a><span class="c">!!     character(len=:),allocatable :: array(:) ! output array of tokens</span>
<a name="ln-3795"></a><span class="c">!!        write(*,*)&#39;INPUT LINE:[&#39;//LINE//&#39;]&#39;</span>
<a name="ln-3796"></a><span class="c">!!        write(*,&#39;(80(&quot;=&quot;))&#39;)</span>
<a name="ln-3797"></a><span class="c">!!        write(*,*)&#39;typical call:&#39;</span>
<a name="ln-3798"></a><span class="c">!!        CALL split(line,array)</span>
<a name="ln-3799"></a><span class="c">!!        write(*,&#39;(i0,&quot; ==&gt; &quot;,a)&#39;)(i,trim(array(i)),i=1,size(array))</span>
<a name="ln-3800"></a><span class="c">!!        write(*,*)&#39;SIZE:&#39;,SIZE(array)</span>
<a name="ln-3801"></a><span class="c">!!        write(*,&#39;(80(&quot;-&quot;))&#39;)</span>
<a name="ln-3802"></a><span class="c">!!        write(*,*)&#39;custom list of delimiters (colon and vertical line):&#39;</span>
<a name="ln-3803"></a><span class="c">!!        CALL split(line,array,delimiters=&#39;:|&#39;,order=&#39;sequential&#39;,nulls=&#39;ignore&#39;)</span>
<a name="ln-3804"></a><span class="c">!!        write(*,&#39;(i0,&quot; ==&gt; &quot;,a)&#39;)(i,trim(array(i)),i=1,size(array))</span>
<a name="ln-3805"></a><span class="c">!!        write(*,*)&#39;SIZE:&#39;,SIZE(array)</span>
<a name="ln-3806"></a><span class="c">!!        write(*,&#39;(80(&quot;-&quot;))&#39;)</span>
<a name="ln-3807"></a><span class="c">!!        write(*,*)&amp;</span>
<a name="ln-3808"></a><span class="c">!!      &amp;&#39;custom list of delimiters, reverse array order and count null fields:&#39;</span>
<a name="ln-3809"></a><span class="c">!!        CALL split(line,array,delimiters=&#39;:|&#39;,order=&#39;reverse&#39;,nulls=&#39;return&#39;)</span>
<a name="ln-3810"></a><span class="c">!!        write(*,&#39;(i0,&quot; ==&gt; &quot;,a)&#39;)(i,trim(array(i)),i=1,size(array))</span>
<a name="ln-3811"></a><span class="c">!!        write(*,*)&#39;SIZE:&#39;,SIZE(array)</span>
<a name="ln-3812"></a><span class="c">!!        write(*,&#39;(80(&quot;-&quot;))&#39;)</span>
<a name="ln-3813"></a><span class="c">!!        write(*,*)&#39;INPUT LINE:[&#39;//LINE//&#39;]&#39;</span>
<a name="ln-3814"></a><span class="c">!!        write(*,*)&amp;</span>
<a name="ln-3815"></a><span class="c">!!        &amp;&#39;default delimiters and reverse array order and return null fields:&#39;</span>
<a name="ln-3816"></a><span class="c">!!        CALL split(line,array,delimiters=&#39;&#39;,order=&#39;reverse&#39;,nulls=&#39;return&#39;)</span>
<a name="ln-3817"></a><span class="c">!!        write(*,&#39;(i0,&quot; ==&gt; &quot;,a)&#39;)(i,trim(array(i)),i=1,size(array))</span>
<a name="ln-3818"></a><span class="c">!!        write(*,*)&#39;SIZE:&#39;,SIZE(array)</span>
<a name="ln-3819"></a><span class="c">!!     end program demo_split</span>
<a name="ln-3820"></a><span class="c">!!</span>
<a name="ln-3821"></a><span class="c">!!   Output</span>
<a name="ln-3822"></a><span class="c">!!</span>
<a name="ln-3823"></a><span class="c">!!    &gt; INPUT LINE:[  aBcdef   ghijklmnop qrstuvwxyz  1:|:2     333|333 a B cc    ]</span>
<a name="ln-3824"></a><span class="c">!!    &gt; ===========================================================================</span>
<a name="ln-3825"></a><span class="c">!!    &gt;  typical call:</span>
<a name="ln-3826"></a><span class="c">!!    &gt; 1 ==&gt; aBcdef</span>
<a name="ln-3827"></a><span class="c">!!    &gt; 2 ==&gt; ghijklmnop</span>
<a name="ln-3828"></a><span class="c">!!    &gt; 3 ==&gt; qrstuvwxyz</span>
<a name="ln-3829"></a><span class="c">!!    &gt; 4 ==&gt; 1:|:2</span>
<a name="ln-3830"></a><span class="c">!!    &gt; 5 ==&gt; 333|333</span>
<a name="ln-3831"></a><span class="c">!!    &gt; 6 ==&gt; a</span>
<a name="ln-3832"></a><span class="c">!!    &gt; 7 ==&gt; B</span>
<a name="ln-3833"></a><span class="c">!!    &gt; 8 ==&gt; cc</span>
<a name="ln-3834"></a><span class="c">!!    &gt;  SIZE:           8</span>
<a name="ln-3835"></a><span class="c">!!    &gt; --------------------------------------------------------------------------</span>
<a name="ln-3836"></a><span class="c">!!    &gt;  custom list of delimiters (colon and vertical line):</span>
<a name="ln-3837"></a><span class="c">!!    &gt; 1 ==&gt;   aBcdef   ghijklmnop qrstuvwxyz  1</span>
<a name="ln-3838"></a><span class="c">!!    &gt; 2 ==&gt; 2     333</span>
<a name="ln-3839"></a><span class="c">!!    &gt; 3 ==&gt; 333 a B cc</span>
<a name="ln-3840"></a><span class="c">!!    &gt;  SIZE:           3</span>
<a name="ln-3841"></a><span class="c">!!    &gt; --------------------------------------------------------------------------</span>
<a name="ln-3842"></a><span class="c">!!    &gt;  custom list of delimiters, reverse array order and return null fields:</span>
<a name="ln-3843"></a><span class="c">!!    &gt; 1 ==&gt; 333 a B cc</span>
<a name="ln-3844"></a><span class="c">!!    &gt; 2 ==&gt; 2     333</span>
<a name="ln-3845"></a><span class="c">!!    &gt; 3 ==&gt;</span>
<a name="ln-3846"></a><span class="c">!!    &gt; 4 ==&gt;</span>
<a name="ln-3847"></a><span class="c">!!    &gt; 5 ==&gt;   aBcdef   ghijklmnop qrstuvwxyz  1</span>
<a name="ln-3848"></a><span class="c">!!    &gt;  SIZE:           5</span>
<a name="ln-3849"></a><span class="c">!!    &gt; --------------------------------------------------------------------------</span>
<a name="ln-3850"></a><span class="c">!!    &gt;  INPUT LINE:[  aBcdef   ghijklmnop qrstuvwxyz  1:|:2     333|333 a B cc    ]</span>
<a name="ln-3851"></a><span class="c">!!    &gt;  default delimiters and reverse array order and count null fields:</span>
<a name="ln-3852"></a><span class="c">!!    &gt; 1 ==&gt;</span>
<a name="ln-3853"></a><span class="c">!!    &gt; 2 ==&gt;</span>
<a name="ln-3854"></a><span class="c">!!    &gt; 3 ==&gt;</span>
<a name="ln-3855"></a><span class="c">!!    &gt; 4 ==&gt; cc</span>
<a name="ln-3856"></a><span class="c">!!    &gt; 5 ==&gt; B</span>
<a name="ln-3857"></a><span class="c">!!    &gt; 6 ==&gt; a</span>
<a name="ln-3858"></a><span class="c">!!    &gt; 7 ==&gt; 333|333</span>
<a name="ln-3859"></a><span class="c">!!    &gt; 8 ==&gt;</span>
<a name="ln-3860"></a><span class="c">!!    &gt; 9 ==&gt;</span>
<a name="ln-3861"></a><span class="c">!!    &gt; 10 ==&gt;</span>
<a name="ln-3862"></a><span class="c">!!    &gt; 11 ==&gt;</span>
<a name="ln-3863"></a><span class="c">!!    &gt; 12 ==&gt; 1:|:2</span>
<a name="ln-3864"></a><span class="c">!!    &gt; 13 ==&gt;</span>
<a name="ln-3865"></a><span class="c">!!    &gt; 14 ==&gt; qrstuvwxyz</span>
<a name="ln-3866"></a><span class="c">!!    &gt; 15 ==&gt; ghijklmnop</span>
<a name="ln-3867"></a><span class="c">!!    &gt; 16 ==&gt;</span>
<a name="ln-3868"></a><span class="c">!!    &gt; 17 ==&gt;</span>
<a name="ln-3869"></a><span class="c">!!    &gt; 18 ==&gt; aBcdef</span>
<a name="ln-3870"></a><span class="c">!!    &gt; 19 ==&gt;</span>
<a name="ln-3871"></a><span class="c">!!    &gt; 20 ==&gt;</span>
<a name="ln-3872"></a><span class="c">!!    &gt;  SIZE:          20</span>
<a name="ln-3873"></a><span class="c">!!##AUTHOR</span>
<a name="ln-3874"></a><span class="c">!!    John S. Urban</span>
<a name="ln-3875"></a><span class="c">!!##LICENSE</span>
<a name="ln-3876"></a><span class="c">!!    Public Domain</span>
<a name="ln-3877"></a><span class="k">subroutine </span><span class="n">split</span><span class="p">(</span><span class="n">input_line</span><span class="p">,</span><span class="k">array</span><span class="p">,</span><span class="n">delimiters</span><span class="p">,</span><span class="n">order</span><span class="p">,</span><span class="n">nulls</span><span class="p">)</span>
<a name="ln-3878"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-3879"></a>
<a name="ln-3880"></a><span class="c">! ident_20=&quot;@(#)M_CLI2::split(3f): parse string on delimiter characters and store tokens into an allocatable array&quot;</span>
<a name="ln-3881"></a>
<a name="ln-3882"></a><span class="c">!  John S. Urban</span>
<a name="ln-3883"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-3884"></a><span class="k">intrinsic </span><span class="nb">index</span><span class="p">,</span> <span class="nb">min</span><span class="p">,</span> <span class="nb">present</span><span class="p">,</span> <span class="nb">len</span>
<a name="ln-3885"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-3886"></a><span class="c">!  given a line of structure &quot; par1 par2 par3 ... parn &quot; store each par(n) into a separate variable in array.</span>
<a name="ln-3887"></a><span class="c">!    o by default adjacent delimiters in the input string do not create an empty string in the output array</span>
<a name="ln-3888"></a><span class="c">!    o no quoting of delimiters is supported</span>
<a name="ln-3889"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>              <span class="kd">::</span> <span class="n">input_line</span>  <span class="c">! input string to tokenize</span>
<a name="ln-3890"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">optional</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>     <span class="kd">::</span> <span class="n">delimiters</span>  <span class="c">! list of delimiter characters</span>
<a name="ln-3891"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">optional</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>     <span class="kd">::</span> <span class="n">order</span>       <span class="c">! order of output array sequential|[reverse|right]</span>
<a name="ln-3892"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">optional</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>     <span class="kd">::</span> <span class="n">nulls</span>       <span class="c">! return strings composed of delimiters or not ignore|return|ignoreend</span>
<a name="ln-3893"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span> <span class="kd">::</span> <span class="k">array</span><span class="p">(:)</span>    <span class="c">! output array of tokens</span>
<a name="ln-3894"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-3895"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">n</span>                      <span class="c">! max number of strings INPUT_LINE could split into if all delimiter</span>
<a name="ln-3896"></a><span class="kt">integer</span><span class="p">,</span><span class="k">allocatable</span>           <span class="kd">::</span> <span class="n">ibegin</span><span class="p">(:)</span>              <span class="c">! positions in input string where tokens start</span>
<a name="ln-3897"></a><span class="kt">integer</span><span class="p">,</span><span class="k">allocatable</span>           <span class="kd">::</span> <span class="n">iterm</span><span class="p">(:)</span>               <span class="c">! positions in input string where tokens end</span>
<a name="ln-3898"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>  <span class="kd">::</span> <span class="n">dlim</span>                   <span class="c">! string containing delimiter characters</span>
<a name="ln-3899"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>  <span class="kd">::</span> <span class="n">ordr</span>                   <span class="c">! string containing order keyword</span>
<a name="ln-3900"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>  <span class="kd">::</span> <span class="n">nlls</span>                   <span class="c">! string containing nulls keyword</span>
<a name="ln-3901"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">ii</span><span class="p">,</span><span class="n">iiii</span>                <span class="c">! loop parameters used to control print order</span>
<a name="ln-3902"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">icount</span>                 <span class="c">! number of tokens found</span>
<a name="ln-3903"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">iilen</span>                  <span class="c">! length of input string with trailing spaces trimmed</span>
<a name="ln-3904"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">i10</span><span class="p">,</span><span class="n">i20</span><span class="p">,</span><span class="n">i30</span>            <span class="c">! loop counters</span>
<a name="ln-3905"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">icol</span>                   <span class="c">! pointer into input string as it is being parsed</span>
<a name="ln-3906"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">idlim</span>                  <span class="c">! number of delimiter characters</span>
<a name="ln-3907"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">ifound</span>                 <span class="c">! where next delimiter character is found in remaining input string data</span>
<a name="ln-3908"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">inotnull</span>               <span class="c">! count strings not composed of delimiters</span>
<a name="ln-3909"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">ireturn</span>                <span class="c">! number of tokens returned</span>
<a name="ln-3910"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">imax</span>                   <span class="c">! length of longest token</span>
<a name="ln-3911"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-3912"></a>   <span class="c">! decide on value for optional DELIMITERS parameter</span>
<a name="ln-3913"></a>   <span class="k">if</span> <span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">delimiters</span><span class="p">))</span> <span class="k">then</span>                                     <span class="c">! optional delimiter list was present</span>
<a name="ln-3914"></a>      <span class="k">if</span><span class="p">(</span><span class="n">delimiters</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39;&#39;</span><span class="p">)</span><span class="k">then</span>                                       <span class="c">! if DELIMITERS was specified and not null use it</span>
<a name="ln-3915"></a>         <span class="n">dlim</span><span class="o">=</span><span class="n">delimiters</span>
<a name="ln-3916"></a>      <span class="k">else</span>                                                           <span class="c">! DELIMITERS was specified on call as empty string</span>
<a name="ln-3917"></a>         <span class="n">dlim</span><span class="o">=</span><span class="s1">&#39; &#39;</span><span class="o">//</span><span class="nb">char</span><span class="p">(</span><span class="mi">9</span><span class="p">)</span><span class="o">//</span><span class="nb">char</span><span class="p">(</span><span class="mi">10</span><span class="p">)</span><span class="o">//</span><span class="nb">char</span><span class="p">(</span><span class="mi">11</span><span class="p">)</span><span class="o">//</span><span class="nb">char</span><span class="p">(</span><span class="mi">12</span><span class="p">)</span><span class="o">//</span><span class="nb">char</span><span class="p">(</span><span class="mi">13</span><span class="p">)</span><span class="o">//</span><span class="nb">char</span><span class="p">(</span><span class="mi">0</span><span class="p">)</span><span class="o">//</span><span class="s1">&#39;,:&#39;</span> <span class="c">! use default delimiter when not specified</span>
<a name="ln-3918"></a>      <span class="k">endif</span>
<a name="ln-3919"></a><span class="k">   else</span>                                                              <span class="c">! no delimiter value was specified</span>
<a name="ln-3920"></a>      <span class="n">dlim</span><span class="o">=</span><span class="s1">&#39; &#39;</span><span class="o">//</span><span class="nb">char</span><span class="p">(</span><span class="mi">9</span><span class="p">)</span><span class="o">//</span><span class="nb">char</span><span class="p">(</span><span class="mi">10</span><span class="p">)</span><span class="o">//</span><span class="nb">char</span><span class="p">(</span><span class="mi">11</span><span class="p">)</span><span class="o">//</span><span class="nb">char</span><span class="p">(</span><span class="mi">12</span><span class="p">)</span><span class="o">//</span><span class="nb">char</span><span class="p">(</span><span class="mi">13</span><span class="p">)</span><span class="o">//</span><span class="nb">char</span><span class="p">(</span><span class="mi">0</span><span class="p">)</span><span class="o">//</span><span class="s1">&#39;,:&#39;</span>    <span class="c">! use default delimiter when not specified</span>
<a name="ln-3921"></a>   <span class="k">endif</span>
<a name="ln-3922"></a><span class="k">   </span><span class="n">idlim</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">dlim</span><span class="p">)</span>                                                   <span class="c">! dlim a lot of blanks on some machines if dlim is a big string</span>
<a name="ln-3923"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-3924"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">order</span><span class="p">))</span><span class="k">then</span><span class="p">;</span> <span class="n">ordr</span><span class="o">=</span><span class="n">lower</span><span class="p">(</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">order</span><span class="p">));</span> <span class="k">else</span><span class="p">;</span> <span class="n">ordr</span><span class="o">=</span><span class="s1">&#39;sequential&#39;</span><span class="p">;</span> <span class="k">endif</span> <span class="c">! decide on value for optional ORDER parameter</span>
<a name="ln-3925"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">nulls</span><span class="p">))</span><span class="k">then</span><span class="p">;</span> <span class="n">nlls</span><span class="o">=</span><span class="n">lower</span><span class="p">(</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">nulls</span><span class="p">));</span> <span class="k">else</span><span class="p">;</span> <span class="n">nlls</span><span class="o">=</span><span class="s1">&#39;ignore&#39;</span>    <span class="p">;</span> <span class="k">endif</span> <span class="c">! optional parameter</span>
<a name="ln-3926"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-3927"></a>   <span class="n">n</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">input_line</span><span class="p">)</span><span class="o">+</span><span class="mi">1</span>                        <span class="c">! max number of strings INPUT_LINE could split into if all delimiter</span>
<a name="ln-3928"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">ibegin</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">ibegin</span><span class="p">)</span>    <span class="c">!x! intel compiler says allocated already ???</span>
<a name="ln-3929"></a>   <span class="k">allocate</span><span class="p">(</span><span class="n">ibegin</span><span class="p">(</span><span class="n">n</span><span class="p">))</span>                        <span class="c">! allocate enough space to hold starting location of tokens if string all tokens</span>
<a name="ln-3930"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">iterm</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">iterm</span><span class="p">)</span>      <span class="c">!x! intel compiler says allocated already ???</span>
<a name="ln-3931"></a>   <span class="k">allocate</span><span class="p">(</span><span class="n">iterm</span><span class="p">(</span><span class="n">n</span><span class="p">))</span>                         <span class="c">! allocate enough space to hold ending location of tokens if string all tokens</span>
<a name="ln-3932"></a>   <span class="n">ibegin</span><span class="p">(:)</span><span class="o">=</span><span class="mi">1</span>
<a name="ln-3933"></a>   <span class="n">iterm</span><span class="p">(:)</span><span class="o">=</span><span class="mi">1</span>
<a name="ln-3934"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-3935"></a>   <span class="n">iilen</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">input_line</span><span class="p">)</span>                                          <span class="c">! IILEN is the column position of the last non-blank character</span>
<a name="ln-3936"></a>   <span class="n">icount</span><span class="o">=</span><span class="mi">0</span>                                                       <span class="c">! how many tokens found</span>
<a name="ln-3937"></a>   <span class="n">inotnull</span><span class="o">=</span><span class="mi">0</span>                                                     <span class="c">! how many tokens found not composed of delimiters</span>
<a name="ln-3938"></a>   <span class="n">imax</span><span class="o">=</span><span class="mi">0</span>                                                         <span class="c">! length of longest token found</span>
<a name="ln-3939"></a>   <span class="k">if</span><span class="p">(</span><span class="n">iilen</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                             <span class="c">! there is at least one non-delimiter in INPUT_LINE if get here</span>
<a name="ln-3940"></a>      <span class="n">icol</span><span class="o">=</span><span class="mi">1</span>                                                      <span class="c">! initialize pointer into input line</span>
<a name="ln-3941"></a>      <span class="n">INFINITE</span><span class="p">:</span> <span class="k">do </span><span class="n">i30</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">iilen</span><span class="p">,</span><span class="mi">1</span>                                  <span class="c">! store into each array element</span>
<a name="ln-3942"></a>         <span class="n">ibegin</span><span class="p">(</span><span class="n">i30</span><span class="p">)</span><span class="o">=</span><span class="n">icol</span>                                         <span class="c">! assume start new token on the character</span>
<a name="ln-3943"></a>         <span class="k">if</span><span class="p">(</span><span class="nb">index</span><span class="p">(</span><span class="n">dlim</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">idlim</span><span class="p">),</span><span class="n">input_line</span><span class="p">(</span><span class="n">icol</span><span class="p">:</span><span class="n">icol</span><span class="p">)).</span><span class="n">eq</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>  <span class="c">! if current character is not a delimiter</span>
<a name="ln-3944"></a>            <span class="n">iterm</span><span class="p">(</span><span class="n">i30</span><span class="p">)</span><span class="o">=</span><span class="n">iilen</span>                                      <span class="c">! initially assume no more tokens</span>
<a name="ln-3945"></a>            <span class="k">do </span><span class="n">i10</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">idlim</span>                                        <span class="c">! search for next delimiter</span>
<a name="ln-3946"></a>               <span class="n">ifound</span><span class="o">=</span><span class="nb">index</span><span class="p">(</span><span class="n">input_line</span><span class="p">(</span><span class="n">ibegin</span><span class="p">(</span><span class="n">i30</span><span class="p">):</span><span class="n">iilen</span><span class="p">),</span><span class="n">dlim</span><span class="p">(</span><span class="n">i10</span><span class="p">:</span><span class="n">i10</span><span class="p">))</span>
<a name="ln-3947"></a>               <span class="k">IF</span><span class="p">(</span><span class="n">ifound</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-3948"></a><span class="k">                  </span><span class="n">iterm</span><span class="p">(</span><span class="n">i30</span><span class="p">)</span><span class="o">=</span><span class="nb">min</span><span class="p">(</span><span class="n">iterm</span><span class="p">(</span><span class="n">i30</span><span class="p">),</span><span class="n">ifound</span><span class="o">+</span><span class="n">ibegin</span><span class="p">(</span><span class="n">i30</span><span class="p">)</span><span class="o">-</span><span class="mi">2</span><span class="p">)</span>
<a name="ln-3949"></a>               <span class="k">endif</span>
<a name="ln-3950"></a><span class="k">            enddo</span>
<a name="ln-3951"></a><span class="k">            </span><span class="n">icol</span><span class="o">=</span><span class="n">iterm</span><span class="p">(</span><span class="n">i30</span><span class="p">)</span><span class="o">+</span><span class="mi">2</span>                                     <span class="c">! next place to look as found end of this token</span>
<a name="ln-3952"></a>            <span class="n">inotnull</span><span class="o">=</span><span class="n">inotnull</span><span class="o">+</span><span class="mi">1</span>                                   <span class="c">! increment count of number of tokens not composed of delimiters</span>
<a name="ln-3953"></a>         <span class="k">else</span>                                                     <span class="c">! character is a delimiter for a null string</span>
<a name="ln-3954"></a>            <span class="n">iterm</span><span class="p">(</span><span class="n">i30</span><span class="p">)</span><span class="o">=</span><span class="n">icol</span><span class="o">-</span><span class="mi">1</span>                                     <span class="c">! record assumed end of string. Will be less than beginning</span>
<a name="ln-3955"></a>            <span class="n">icol</span><span class="o">=</span><span class="n">icol</span><span class="o">+</span><span class="mi">1</span>                                           <span class="c">! advance pointer into input string</span>
<a name="ln-3956"></a>         <span class="k">endif</span>
<a name="ln-3957"></a><span class="k">         </span><span class="n">imax</span><span class="o">=</span><span class="nb">max</span><span class="p">(</span><span class="n">imax</span><span class="p">,</span><span class="n">iterm</span><span class="p">(</span><span class="n">i30</span><span class="p">)</span><span class="o">-</span><span class="n">ibegin</span><span class="p">(</span><span class="n">i30</span><span class="p">)</span><span class="o">+</span><span class="mi">1</span><span class="p">)</span>
<a name="ln-3958"></a>         <span class="n">icount</span><span class="o">=</span><span class="n">i30</span>                                               <span class="c">! increment count of number of tokens found</span>
<a name="ln-3959"></a>         <span class="k">if</span><span class="p">(</span><span class="n">icol</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="n">iilen</span><span class="p">)</span><span class="k">then</span>                                     <span class="c">! no text left</span>
<a name="ln-3960"></a>            <span class="k">exit </span><span class="n">INFINITE</span>
<a name="ln-3961"></a>         <span class="k">endif</span>
<a name="ln-3962"></a><span class="k">      enddo </span><span class="n">INFINITE</span>
<a name="ln-3963"></a>   <span class="k">endif</span>
<a name="ln-3964"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-3965"></a>   <span class="k">select case</span> <span class="p">(</span><span class="nb">trim</span><span class="p">(</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">nlls</span><span class="p">)))</span>
<a name="ln-3966"></a>   <span class="k">case</span> <span class="p">(</span><span class="s1">&#39;ignore&#39;</span><span class="p">,</span><span class="s1">&#39;&#39;</span><span class="p">,</span><span class="s1">&#39;ignoreend&#39;</span><span class="p">)</span>
<a name="ln-3967"></a>      <span class="n">ireturn</span><span class="o">=</span><span class="n">inotnull</span>
<a name="ln-3968"></a>   <span class="k">case </span><span class="n">default</span>
<a name="ln-3969"></a>      <span class="n">ireturn</span><span class="o">=</span><span class="n">icount</span>
<a name="ln-3970"></a>   <span class="k">end select</span>
<a name="ln-3971"></a><span class="k">   if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="k">array</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="k">array</span><span class="p">)</span>
<a name="ln-3972"></a>   <span class="k">allocate</span><span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="n">imax</span><span class="p">)</span> <span class="kd">::</span> <span class="k">array</span><span class="p">(</span><span class="n">ireturn</span><span class="p">))</span>                <span class="c">! allocate the array to return</span>
<a name="ln-3973"></a>   <span class="c">!allocate(array(ireturn))                                       ! allocate the array to turn</span>
<a name="ln-3974"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-3975"></a>   <span class="k">select case</span> <span class="p">(</span><span class="nb">trim</span><span class="p">(</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">ordr</span><span class="p">)))</span>                              <span class="c">! decide which order to store tokens</span>
<a name="ln-3976"></a>   <span class="k">case</span> <span class="p">(</span><span class="s1">&#39;reverse&#39;</span><span class="p">,</span><span class="s1">&#39;right&#39;</span><span class="p">)</span> <span class="p">;</span> <span class="n">ii</span><span class="o">=</span><span class="n">ireturn</span> <span class="p">;</span> <span class="n">iiii</span><span class="o">=-</span><span class="mi">1</span>                <span class="c">! last to first</span>
<a name="ln-3977"></a>   <span class="k">case </span><span class="n">default</span>             <span class="p">;</span> <span class="n">ii</span><span class="o">=</span><span class="mi">1</span>       <span class="p">;</span> <span class="n">iiii</span><span class="o">=</span><span class="mi">1</span>                 <span class="c">! first to last</span>
<a name="ln-3978"></a>   <span class="k">end select</span>
<a name="ln-3979"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-3980"></a>   <span class="k">do </span><span class="n">i20</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">icount</span>                                                <span class="c">! fill the array with the tokens that were found</span>
<a name="ln-3981"></a>      <span class="k">if</span><span class="p">(</span><span class="n">iterm</span><span class="p">(</span><span class="n">i20</span><span class="p">).</span><span class="n">lt</span><span class="p">.</span><span class="n">ibegin</span><span class="p">(</span><span class="n">i20</span><span class="p">))</span><span class="k">then</span>
<a name="ln-3982"></a><span class="k">         select case</span> <span class="p">(</span><span class="nb">trim</span><span class="p">(</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">nlls</span><span class="p">)))</span>
<a name="ln-3983"></a>         <span class="k">case</span> <span class="p">(</span><span class="s1">&#39;ignore&#39;</span><span class="p">,</span><span class="s1">&#39;&#39;</span><span class="p">,</span><span class="s1">&#39;ignoreend&#39;</span><span class="p">)</span>
<a name="ln-3984"></a>         <span class="k">case </span><span class="n">default</span>
<a name="ln-3985"></a>            <span class="k">array</span><span class="p">(</span><span class="n">ii</span><span class="p">)</span><span class="o">=</span><span class="s1">&#39; &#39;</span>
<a name="ln-3986"></a>            <span class="n">ii</span><span class="o">=</span><span class="n">ii</span><span class="o">+</span><span class="n">iiii</span>
<a name="ln-3987"></a>         <span class="k">end select</span>
<a name="ln-3988"></a><span class="k">      else</span>
<a name="ln-3989"></a><span class="k">         array</span><span class="p">(</span><span class="n">ii</span><span class="p">)</span><span class="o">=</span><span class="n">input_line</span><span class="p">(</span><span class="n">ibegin</span><span class="p">(</span><span class="n">i20</span><span class="p">):</span><span class="n">iterm</span><span class="p">(</span><span class="n">i20</span><span class="p">))</span>
<a name="ln-3990"></a>         <span class="n">ii</span><span class="o">=</span><span class="n">ii</span><span class="o">+</span><span class="n">iiii</span>
<a name="ln-3991"></a>      <span class="k">endif</span>
<a name="ln-3992"></a><span class="k">   enddo</span>
<a name="ln-3993"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-3994"></a>   <span class="k">end subroutine </span><span class="n">split</span>
<a name="ln-3995"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3996"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-3997"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-3998"></a><span class="c">!&gt;</span>
<a name="ln-3999"></a><span class="c">!!##NAME</span>
<a name="ln-4000"></a><span class="c">!!    replace_str(3f) - [M_CLI2:EDITING] function globally replaces one</span>
<a name="ln-4001"></a><span class="c">!!    substring for another in string</span>
<a name="ln-4002"></a><span class="c">!!    (LICENSE:PD)</span>
<a name="ln-4003"></a><span class="c">!!</span>
<a name="ln-4004"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-4005"></a><span class="c">!!</span>
<a name="ln-4006"></a><span class="c">!!    function replace_str(targetline[,old,new|cmd],range,ierr) result (newline)</span>
<a name="ln-4007"></a><span class="c">!!</span>
<a name="ln-4008"></a><span class="c">!!     character(len=*)                       :: targetline</span>
<a name="ln-4009"></a><span class="c">!!     character(len=*),intent(in),optional   :: old</span>
<a name="ln-4010"></a><span class="c">!!     character(len=*),intent(in),optional   :: new</span>
<a name="ln-4011"></a><span class="c">!!     character(len=*),intent(in),optional   :: cmd</span>
<a name="ln-4012"></a><span class="c">!!     integer,intent(in),optional            :: range(2)</span>
<a name="ln-4013"></a><span class="c">!!     integer,intent(out),optional           :: ierr</span>
<a name="ln-4014"></a><span class="c">!!     logical,intent(in),optional            :: clip</span>
<a name="ln-4015"></a><span class="c">!!     character(len=:),allocatable           :: newline</span>
<a name="ln-4016"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-4017"></a><span class="c">!!    Globally replace one substring for another in string.</span>
<a name="ln-4018"></a><span class="c">!!    Either CMD or OLD and NEW must be specified.</span>
<a name="ln-4019"></a><span class="c">!!</span>
<a name="ln-4020"></a><span class="c">!!##OPTIONS</span>
<a name="ln-4021"></a><span class="c">!!     targetline  input line to be changed</span>
<a name="ln-4022"></a><span class="c">!!     old         old substring to replace</span>
<a name="ln-4023"></a><span class="c">!!     new         new substring</span>
<a name="ln-4024"></a><span class="c">!!     cmd         alternate way to specify old and new string, in</span>
<a name="ln-4025"></a><span class="c">!!                 the form c/old/new/; where &quot;/&quot; can be any character</span>
<a name="ln-4026"></a><span class="c">!!                 not in &quot;old&quot; or &quot;new&quot;</span>
<a name="ln-4027"></a><span class="c">!!     range       if present, only change range(1) to range(2) of</span>
<a name="ln-4028"></a><span class="c">!!                 occurrences of old string</span>
<a name="ln-4029"></a><span class="c">!!     ierr        error code. iF ier = -1 bad directive, &gt;= 0 then</span>
<a name="ln-4030"></a><span class="c">!!                 count of changes made</span>
<a name="ln-4031"></a><span class="c">!!     clip        whether to return trailing spaces or not. Defaults to .false.</span>
<a name="ln-4032"></a><span class="c">!!##RETURNS</span>
<a name="ln-4033"></a><span class="c">!!     newline     allocatable string returned</span>
<a name="ln-4034"></a><span class="c">!!</span>
<a name="ln-4035"></a><span class="c">!!##EXAMPLES</span>
<a name="ln-4036"></a><span class="c">!!</span>
<a name="ln-4037"></a><span class="c">!! Sample Program:</span>
<a name="ln-4038"></a><span class="c">!!</span>
<a name="ln-4039"></a><span class="c">!!       program demo_replace_str</span>
<a name="ln-4040"></a><span class="c">!!       use M_CLI2, only : replace_str</span>
<a name="ln-4041"></a><span class="c">!!       implicit none</span>
<a name="ln-4042"></a><span class="c">!!       character(len=:),allocatable :: targetline</span>
<a name="ln-4043"></a><span class="c">!!</span>
<a name="ln-4044"></a><span class="c">!!       targetline=&#39;this is the input string&#39;</span>
<a name="ln-4045"></a><span class="c">!!</span>
<a name="ln-4046"></a><span class="c">!!       call testit(&#39;th&#39;,&#39;TH&#39;,&#39;THis is THe input string&#39;)</span>
<a name="ln-4047"></a><span class="c">!!</span>
<a name="ln-4048"></a><span class="c">!!       ! a null old substring means &quot;at beginning of line&quot;</span>
<a name="ln-4049"></a><span class="c">!!       call testit(&#39;&#39;,&#39;BEFORE:&#39;, &#39;BEFORE:THis is THe input string&#39;)</span>
<a name="ln-4050"></a><span class="c">!!</span>
<a name="ln-4051"></a><span class="c">!!       ! a null new string deletes occurrences of the old substring</span>
<a name="ln-4052"></a><span class="c">!!       call testit(&#39;i&#39;,&#39;&#39;, &#39;BEFORE:THs s THe nput strng&#39;)</span>
<a name="ln-4053"></a><span class="c">!!</span>
<a name="ln-4054"></a><span class="c">!!       write(*,*)&#39;Examples of the use of RANGE=&#39;</span>
<a name="ln-4055"></a><span class="c">!!</span>
<a name="ln-4056"></a><span class="c">!!       targetline=replace_str(&#39;a b ab baaa aaaa&#39;,&#39;a&#39;,&#39;A&#39;)</span>
<a name="ln-4057"></a><span class="c">!!       write(*,*)&#39;replace a with A [&#39;//targetline//&#39;]&#39;</span>
<a name="ln-4058"></a><span class="c">!!</span>
<a name="ln-4059"></a><span class="c">!!       targetline=replace_str(&#39;a b ab baaa aaaa&#39;,&#39;a&#39;,&#39;A&#39;,range=[3,5])</span>
<a name="ln-4060"></a><span class="c">!!       write(*,*)&#39;replace a with A instances 3 to 5 [&#39;//targetline//&#39;]&#39;</span>
<a name="ln-4061"></a><span class="c">!!</span>
<a name="ln-4062"></a><span class="c">!!       targetline=replace_str(&#39;a b ab baaa aaaa&#39;,&#39;a&#39;,&#39;&#39;,range=[3,5])</span>
<a name="ln-4063"></a><span class="c">!!       write(*,*)&#39;replace a with null instances 3 to 5 [&#39;//targetline//&#39;]&#39;</span>
<a name="ln-4064"></a><span class="c">!!</span>
<a name="ln-4065"></a><span class="c">!!       targetline=replace_str(&#39;a b ab baaa aaaa aa aa a a a aa aaaaaa&#39;,&amp;</span>
<a name="ln-4066"></a><span class="c">!!        &amp; &#39;aa&#39;,&#39;CCCC&#39;,range=[3,5])</span>
<a name="ln-4067"></a><span class="c">!!       write(*,*)&#39;replace aa with CCCC instances 3 to 5 [&#39;//targetline//&#39;]&#39;</span>
<a name="ln-4068"></a><span class="c">!!</span>
<a name="ln-4069"></a><span class="c">!!       contains</span>
<a name="ln-4070"></a><span class="c">!!       subroutine testit(old,new,expected)</span>
<a name="ln-4071"></a><span class="c">!!       character(len=*),intent(in) :: old,new,expected</span>
<a name="ln-4072"></a><span class="c">!!       write(*,*)repeat(&#39;=&#39;,79)</span>
<a name="ln-4073"></a><span class="c">!!       write(*,*)&#39;:STARTED [&#39;//targetline//&#39;]&#39;</span>
<a name="ln-4074"></a><span class="c">!!       write(*,*)&#39;:OLD[&#39;//old//&#39;]&#39;, &#39; NEW[&#39;//new//&#39;]&#39;</span>
<a name="ln-4075"></a><span class="c">!!       targetline=replace_str(targetline,old,new)</span>
<a name="ln-4076"></a><span class="c">!!       write(*,*)&#39;:GOT     [&#39;//targetline//&#39;]&#39;</span>
<a name="ln-4077"></a><span class="c">!!       write(*,*)&#39;:EXPECTED[&#39;//expected//&#39;]&#39;</span>
<a name="ln-4078"></a><span class="c">!!       write(*,*)&#39;:TEST    [&#39;,targetline.eq.expected,&#39;]&#39;</span>
<a name="ln-4079"></a><span class="c">!!       end subroutine testit</span>
<a name="ln-4080"></a><span class="c">!!</span>
<a name="ln-4081"></a><span class="c">!!       end program demo_replace_str</span>
<a name="ln-4082"></a><span class="c">!!</span>
<a name="ln-4083"></a><span class="c">!!   Expected output</span>
<a name="ln-4084"></a><span class="c">!!</span>
<a name="ln-4085"></a><span class="c">!!     ===============================================================================</span>
<a name="ln-4086"></a><span class="c">!!     STARTED [this is the input string]</span>
<a name="ln-4087"></a><span class="c">!!     OLD[th] NEW[TH]</span>
<a name="ln-4088"></a><span class="c">!!     GOT     [THis is THe input string]</span>
<a name="ln-4089"></a><span class="c">!!     EXPECTED[THis is THe input string]</span>
<a name="ln-4090"></a><span class="c">!!     TEST    [ T ]</span>
<a name="ln-4091"></a><span class="c">!!     ===============================================================================</span>
<a name="ln-4092"></a><span class="c">!!     STARTED [THis is THe input string]</span>
<a name="ln-4093"></a><span class="c">!!     OLD[] NEW[BEFORE:]</span>
<a name="ln-4094"></a><span class="c">!!     GOT     [BEFORE:THis is THe input string]</span>
<a name="ln-4095"></a><span class="c">!!     EXPECTED[BEFORE:THis is THe input string]</span>
<a name="ln-4096"></a><span class="c">!!     TEST    [ T ]</span>
<a name="ln-4097"></a><span class="c">!!     ===============================================================================</span>
<a name="ln-4098"></a><span class="c">!!     STARTED [BEFORE:THis is THe input string]</span>
<a name="ln-4099"></a><span class="c">!!     OLD[i] NEW[]</span>
<a name="ln-4100"></a><span class="c">!!     GOT     [BEFORE:THs s THe nput strng]</span>
<a name="ln-4101"></a><span class="c">!!     EXPECTED[BEFORE:THs s THe nput strng]</span>
<a name="ln-4102"></a><span class="c">!!     TEST    [ T ]</span>
<a name="ln-4103"></a><span class="c">!!     Examples of the use of RANGE=</span>
<a name="ln-4104"></a><span class="c">!!     replace a with A [A b Ab bAAA AAAA]</span>
<a name="ln-4105"></a><span class="c">!!     replace a with A instances 3 to 5 [a b ab bAAA aaaa]</span>
<a name="ln-4106"></a><span class="c">!!     replace a with null instances 3 to 5 [a b ab b aaaa]</span>
<a name="ln-4107"></a><span class="c">!!     replace aa with CCCC instances 3 to 5 [a b ab baaa aaCCCC CCCC CCCC</span>
<a name="ln-4108"></a><span class="c">!!     a a a aa aaaaaa]</span>
<a name="ln-4109"></a><span class="c">!!</span>
<a name="ln-4110"></a><span class="c">!!##AUTHOR</span>
<a name="ln-4111"></a><span class="c">!!    John S. Urban</span>
<a name="ln-4112"></a><span class="c">!!##LICENSE</span>
<a name="ln-4113"></a><span class="c">!!    Public Domain</span>
<a name="ln-4114"></a><span class="k">subroutine </span><span class="n">crack_cmd</span><span class="p">(</span><span class="n">cmd</span><span class="p">,</span><span class="n">old</span><span class="p">,</span><span class="n">new</span><span class="p">,</span><span class="n">ierr</span><span class="p">)</span>
<a name="ln-4115"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4116"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>              <span class="kd">::</span> <span class="n">cmd</span>
<a name="ln-4117"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span> <span class="kd">::</span> <span class="n">old</span><span class="p">,</span><span class="n">new</span>                <span class="c">! scratch string buffers</span>
<a name="ln-4118"></a><span class="kt">integer</span>                                  <span class="kd">::</span> <span class="n">ierr</span>
<a name="ln-4119"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4120"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">1</span><span class="p">)</span>                         <span class="kd">::</span> <span class="n">delimiters</span>
<a name="ln-4121"></a><span class="kt">integer</span>                                  <span class="kd">::</span> <span class="n">itoken</span>
<a name="ln-4122"></a><span class="kt">integer</span><span class="p">,</span><span class="k">parameter</span>                        <span class="kd">::</span> <span class="n">id</span><span class="o">=</span><span class="mi">2</span>                   <span class="c">! expected location of delimiter</span>
<a name="ln-4123"></a><span class="kt">logical</span>                                  <span class="kd">::</span> <span class="n">ifok</span>
<a name="ln-4124"></a><span class="kt">integer</span>                                  <span class="kd">::</span> <span class="n">lmax</span>                   <span class="c">! length of target string</span>
<a name="ln-4125"></a><span class="kt">integer</span>                                  <span class="kd">::</span> <span class="n">start_token</span><span class="p">,</span><span class="n">end_token</span>
<a name="ln-4126"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4127"></a>   <span class="n">ierr</span><span class="o">=</span><span class="mi">0</span>
<a name="ln-4128"></a>   <span class="n">old</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-4129"></a>   <span class="n">new</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-4130"></a>   <span class="n">lmax</span><span class="o">=</span><span class="nb">len_trim</span><span class="p">(</span><span class="n">cmd</span><span class="p">)</span>                       <span class="c">! significant length of change directive</span>
<a name="ln-4131"></a>
<a name="ln-4132"></a>   <span class="k">if</span><span class="p">(</span><span class="n">lmax</span><span class="p">.</span><span class="n">ge</span><span class="p">.</span><span class="mi">4</span><span class="p">)</span><span class="k">then</span>                      <span class="c">! strtok ignores blank tokens so look for special case where first token is really null</span>
<a name="ln-4133"></a>      <span class="n">delimiters</span><span class="o">=</span><span class="n">cmd</span><span class="p">(</span><span class="n">id</span><span class="p">:</span><span class="n">id</span><span class="p">)</span>               <span class="c">! find delimiter in expected location</span>
<a name="ln-4134"></a>      <span class="n">itoken</span><span class="o">=</span><span class="mi">0</span>                            <span class="c">! initialize strtok(3f) procedure</span>
<a name="ln-4135"></a>
<a name="ln-4136"></a>      <span class="k">if</span><span class="p">(</span><span class="n">strtok</span><span class="p">(</span><span class="n">cmd</span><span class="p">(</span><span class="n">id</span><span class="p">:),</span><span class="n">itoken</span><span class="p">,</span><span class="n">start_token</span><span class="p">,</span><span class="n">end_token</span><span class="p">,</span><span class="n">delimiters</span><span class="p">))</span> <span class="k">then</span>        <span class="c">! find OLD string</span>
<a name="ln-4137"></a>         <span class="n">old</span><span class="o">=</span><span class="n">cmd</span><span class="p">(</span><span class="n">start_token</span><span class="o">+</span><span class="n">id</span><span class="o">-</span><span class="mi">1</span><span class="p">:</span><span class="n">end_token</span><span class="o">+</span><span class="n">id</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span>
<a name="ln-4138"></a>      <span class="k">else</span>
<a name="ln-4139"></a><span class="k">         </span><span class="n">old</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-4140"></a>      <span class="k">endif</span>
<a name="ln-4141"></a>
<a name="ln-4142"></a><span class="k">      if</span><span class="p">(</span><span class="n">cmd</span><span class="p">(</span><span class="n">id</span><span class="p">:</span><span class="n">id</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="n">cmd</span><span class="p">(</span><span class="n">id</span><span class="o">+</span><span class="mi">1</span><span class="p">:</span><span class="n">id</span><span class="o">+</span><span class="mi">1</span><span class="p">))</span><span class="k">then</span>
<a name="ln-4143"></a><span class="k">         </span><span class="n">new</span><span class="o">=</span><span class="n">old</span>
<a name="ln-4144"></a>         <span class="n">old</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-4145"></a>      <span class="k">else</span>                                                                     <span class="c">! normal case</span>
<a name="ln-4146"></a>         <span class="n">ifok</span><span class="o">=</span><span class="n">strtok</span><span class="p">(</span><span class="n">cmd</span><span class="p">(</span><span class="n">id</span><span class="p">:),</span><span class="n">itoken</span><span class="p">,</span><span class="n">start_token</span><span class="p">,</span><span class="n">end_token</span><span class="p">,</span><span class="n">delimiters</span><span class="p">)</span>         <span class="c">! find NEW string</span>
<a name="ln-4147"></a>         <span class="k">if</span><span class="p">(</span><span class="n">end_token</span> <span class="p">.</span><span class="n">eq</span><span class="p">.</span> <span class="p">(</span><span class="nb">len</span><span class="p">(</span><span class="n">cmd</span><span class="p">)</span><span class="o">-</span><span class="n">id</span><span class="o">+</span><span class="mi">1</span><span class="p">)</span> <span class="p">)</span><span class="n">end_token</span><span class="o">=</span><span class="nb">len_trim</span><span class="p">(</span><span class="n">cmd</span><span class="p">(</span><span class="n">id</span><span class="p">:))</span>       <span class="c">! if missing ending delimiter</span>
<a name="ln-4148"></a>         <span class="n">new</span><span class="o">=</span><span class="n">cmd</span><span class="p">(</span><span class="n">start_token</span><span class="o">+</span><span class="n">id</span><span class="o">-</span><span class="mi">1</span><span class="p">:</span><span class="nb">min</span><span class="p">(</span><span class="n">end_token</span><span class="o">+</span><span class="n">id</span><span class="o">-</span><span class="mi">1</span><span class="p">,</span><span class="n">lmax</span><span class="p">))</span>
<a name="ln-4149"></a>      <span class="k">endif</span>
<a name="ln-4150"></a><span class="k">   else</span>                                                                        <span class="c">! command was two or less characters</span>
<a name="ln-4151"></a>      <span class="n">ierr</span><span class="o">=-</span><span class="mi">1</span>
<a name="ln-4152"></a>      <span class="k">call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*crack_cmd* incorrect change directive -too short&#39;</span><span class="p">)</span>
<a name="ln-4153"></a>   <span class="k">endif</span>
<a name="ln-4154"></a>
<a name="ln-4155"></a><span class="k">end subroutine </span><span class="n">crack_cmd</span>
<a name="ln-4156"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-4157"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-4158"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-4159"></a><span class="k">function </span><span class="n">replace_str</span><span class="p">(</span><span class="n">targetline</span><span class="p">,</span><span class="n">old</span><span class="p">,</span><span class="n">new</span><span class="p">,</span><span class="n">ierr</span><span class="p">,</span><span class="n">cmd</span><span class="p">,</span><span class="nb">range</span><span class="p">)</span> <span class="k">result</span> <span class="p">(</span><span class="n">newline</span><span class="p">)</span>
<a name="ln-4160"></a>
<a name="ln-4161"></a><span class="c">! ident_21=&quot;@(#)M_CLI2::replace_str(3f): Globally replace one substring for another in string&quot;</span>
<a name="ln-4162"></a>
<a name="ln-4163"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4164"></a><span class="c">! parameters</span>
<a name="ln-4165"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>            <span class="kd">::</span> <span class="n">targetline</span>   <span class="c">! input line to be changed</span>
<a name="ln-4166"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>   <span class="kd">::</span> <span class="n">old</span>          <span class="c">! old substring to replace</span>
<a name="ln-4167"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>   <span class="kd">::</span> <span class="n">new</span>          <span class="c">! new substring</span>
<a name="ln-4168"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">),</span><span class="k">optional</span>           <span class="kd">::</span> <span class="n">ierr</span>         <span class="c">! error code. if ierr = -1 bad directive, &gt;=0 then ierr changes made</span>
<a name="ln-4169"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>   <span class="kd">::</span> <span class="n">cmd</span>          <span class="c">! contains the instructions changing the string</span>
<a name="ln-4170"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>            <span class="kd">::</span> <span class="nb">range</span><span class="p">(</span><span class="mi">2</span><span class="p">)</span>     <span class="c">! start and end of which changes to make</span>
<a name="ln-4171"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4172"></a><span class="c">! returns</span>
<a name="ln-4173"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>  <span class="kd">::</span> <span class="n">newline</span>               <span class="c">! output string buffer</span>
<a name="ln-4174"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4175"></a><span class="c">! local</span>
<a name="ln-4176"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>  <span class="kd">::</span> <span class="n">new_local</span><span class="p">,</span> <span class="n">old_local</span>
<a name="ln-4177"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">icount</span><span class="p">,</span><span class="n">ichange</span><span class="p">,</span><span class="n">ier2</span>
<a name="ln-4178"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">original_input_length</span>
<a name="ln-4179"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">len_old</span><span class="p">,</span> <span class="n">len_new</span>
<a name="ln-4180"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">ladd</span>
<a name="ln-4181"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">left_margin</span><span class="p">,</span> <span class="n">right_margin</span>
<a name="ln-4182"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">ind</span>
<a name="ln-4183"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">ic</span>
<a name="ln-4184"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">iichar</span>
<a name="ln-4185"></a><span class="kt">integer</span>                       <span class="kd">::</span> <span class="n">range_local</span><span class="p">(</span><span class="mi">2</span><span class="p">)</span>
<a name="ln-4186"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4187"></a><span class="c">!  get old_local and new_local from cmd or old and new</span>
<a name="ln-4188"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">cmd</span><span class="p">))</span><span class="k">then</span>
<a name="ln-4189"></a><span class="k">      call </span><span class="n">crack_cmd</span><span class="p">(</span><span class="n">cmd</span><span class="p">,</span><span class="n">old_local</span><span class="p">,</span><span class="n">new_local</span><span class="p">,</span><span class="n">ier2</span><span class="p">)</span>
<a name="ln-4190"></a>      <span class="k">if</span><span class="p">(</span><span class="n">ier2</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-4191"></a><span class="k">         </span><span class="n">newline</span><span class="o">=</span><span class="n">targetline</span>  <span class="c">! if no changes are made return original string on error</span>
<a name="ln-4192"></a>         <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">ierr</span><span class="p">))</span><span class="n">ierr</span><span class="o">=</span><span class="n">ier2</span>
<a name="ln-4193"></a>         <span class="k">return</span>
<a name="ln-4194"></a><span class="k">      endif</span>
<a name="ln-4195"></a><span class="k">   </span><span class="n">elseif</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">old</span><span class="p">).</span><span class="nb">and</span><span class="p">.</span><span class="nb">present</span><span class="p">(</span><span class="n">new</span><span class="p">))</span><span class="k">then</span>
<a name="ln-4196"></a><span class="k">      </span><span class="n">old_local</span><span class="o">=</span><span class="n">old</span>
<a name="ln-4197"></a>      <span class="n">new_local</span><span class="o">=</span><span class="n">new</span>
<a name="ln-4198"></a>   <span class="k">else</span>
<a name="ln-4199"></a><span class="k">      </span><span class="n">newline</span><span class="o">=</span><span class="n">targetline</span>  <span class="c">! if no changes are made return original string on error</span>
<a name="ln-4200"></a>      <span class="k">call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*replace_str* must specify OLD and NEW or CMD&#39;</span><span class="p">)</span>
<a name="ln-4201"></a>      <span class="k">return</span>
<a name="ln-4202"></a><span class="k">   endif</span>
<a name="ln-4203"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4204"></a>   <span class="n">icount</span><span class="o">=</span><span class="mi">0</span>                                            <span class="c">! initialize error flag/change count</span>
<a name="ln-4205"></a>   <span class="n">ichange</span><span class="o">=</span><span class="mi">0</span>                                           <span class="c">! initialize error flag/change count</span>
<a name="ln-4206"></a>   <span class="n">original_input_length</span><span class="o">=</span><span class="nb">len_trim</span><span class="p">(</span><span class="n">targetline</span><span class="p">)</span>          <span class="c">! get non-blank length of input line</span>
<a name="ln-4207"></a>   <span class="n">len_old</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">old_local</span><span class="p">)</span>                              <span class="c">! length of old substring to be replaced</span>
<a name="ln-4208"></a>   <span class="n">len_new</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">new_local</span><span class="p">)</span>                              <span class="c">! length of new substring to replace old substring</span>
<a name="ln-4209"></a>   <span class="n">left_margin</span><span class="o">=</span><span class="mi">1</span>                                       <span class="c">! left_margin is left margin of window to change</span>
<a name="ln-4210"></a>   <span class="n">right_margin</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">targetline</span><span class="p">)</span>                        <span class="c">! right_margin is right margin of window to change</span>
<a name="ln-4211"></a>   <span class="n">newline</span><span class="o">=</span><span class="s1">&#39;&#39;</span>                                          <span class="c">! begin with a blank line as output string</span>
<a name="ln-4212"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4213"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="nb">range</span><span class="p">))</span><span class="k">then</span>
<a name="ln-4214"></a><span class="k">      </span><span class="n">range_local</span><span class="o">=</span><span class="nb">range</span>
<a name="ln-4215"></a><span class="nb">   </span><span class="k">else</span>
<a name="ln-4216"></a><span class="k">      </span><span class="n">range_local</span><span class="o">=</span><span class="p">[</span><span class="mi">1</span><span class="p">,</span><span class="n">original_input_length</span><span class="p">]</span>
<a name="ln-4217"></a>   <span class="k">endif</span>
<a name="ln-4218"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4219"></a>   <span class="k">if</span><span class="p">(</span><span class="n">len_old</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                <span class="c">! c//new/ means insert new at beginning of line (or left margin)</span>
<a name="ln-4220"></a>      <span class="n">iichar</span><span class="o">=</span><span class="n">len_new</span> <span class="o">+</span> <span class="n">original_input_length</span>
<a name="ln-4221"></a>      <span class="k">if</span><span class="p">(</span><span class="n">len_new</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-4222"></a><span class="k">         </span><span class="n">newline</span><span class="o">=</span><span class="n">new_local</span><span class="p">(:</span><span class="n">len_new</span><span class="p">)</span><span class="o">//</span><span class="n">targetline</span><span class="p">(</span><span class="n">left_margin</span><span class="p">:</span><span class="n">original_input_length</span><span class="p">)</span>
<a name="ln-4223"></a>      <span class="k">else</span>
<a name="ln-4224"></a><span class="k">         </span><span class="n">newline</span><span class="o">=</span><span class="n">targetline</span><span class="p">(</span><span class="n">left_margin</span><span class="p">:</span><span class="n">original_input_length</span><span class="p">)</span>
<a name="ln-4225"></a>      <span class="k">endif</span>
<a name="ln-4226"></a><span class="k">      </span><span class="n">ichange</span><span class="o">=</span><span class="mi">1</span>                                        <span class="c">! made one change. actually, c/// should maybe return 0</span>
<a name="ln-4227"></a>      <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">ierr</span><span class="p">))</span><span class="n">ierr</span><span class="o">=</span><span class="n">ichange</span>
<a name="ln-4228"></a>      <span class="k">return</span>
<a name="ln-4229"></a><span class="k">   endif</span>
<a name="ln-4230"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4231"></a>   <span class="n">iichar</span><span class="o">=</span><span class="n">left_margin</span>                                  <span class="c">! place to put characters into output string</span>
<a name="ln-4232"></a>   <span class="n">ic</span><span class="o">=</span><span class="n">left_margin</span>                                      <span class="c">! place looking at in input string</span>
<a name="ln-4233"></a>   <span class="n">loop</span><span class="p">:</span> <span class="k">do</span>
<a name="ln-4234"></a><span class="k">      </span><span class="n">ind</span><span class="o">=</span><span class="nb">index</span><span class="p">(</span><span class="n">targetline</span><span class="p">(</span><span class="n">ic</span><span class="p">:),</span><span class="n">old_local</span><span class="p">(:</span><span class="n">len_old</span><span class="p">))</span><span class="o">+</span><span class="n">ic</span><span class="o">-</span><span class="mi">1</span> <span class="c">! try finding start of OLD in remaining part of input in change window</span>
<a name="ln-4235"></a>      <span class="k">if</span><span class="p">(</span><span class="n">ind</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="n">ic</span><span class="o">-</span><span class="mf">1.</span><span class="nb">or</span><span class="p">.</span><span class="n">ind</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="n">right_margin</span><span class="p">)</span><span class="k">then</span>          <span class="c">! did not find old string or found old string past edit window</span>
<a name="ln-4236"></a>         <span class="k">exit </span><span class="n">loop</span>                                        <span class="c">! no more changes left to make</span>
<a name="ln-4237"></a>      <span class="k">endif</span>
<a name="ln-4238"></a><span class="k">      </span><span class="n">icount</span><span class="o">=</span><span class="n">icount</span><span class="o">+</span><span class="mi">1</span>                                  <span class="c">! found an old string to change, so increment count of change candidates</span>
<a name="ln-4239"></a>      <span class="k">if</span><span class="p">(</span><span class="n">ind</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="n">ic</span><span class="p">)</span><span class="k">then</span>                                <span class="c">! if found old string past at current position in input string copy unchanged</span>
<a name="ln-4240"></a>         <span class="n">ladd</span><span class="o">=</span><span class="n">ind</span><span class="o">-</span><span class="n">ic</span>                                   <span class="c">! find length of character range to copy as-is from input to output</span>
<a name="ln-4241"></a>         <span class="n">newline</span><span class="o">=</span><span class="n">newline</span><span class="p">(:</span><span class="n">iichar</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span><span class="o">//</span><span class="n">targetline</span><span class="p">(</span><span class="n">ic</span><span class="p">:</span><span class="n">ind</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span>
<a name="ln-4242"></a>         <span class="n">iichar</span><span class="o">=</span><span class="n">iichar</span><span class="o">+</span><span class="n">ladd</span>
<a name="ln-4243"></a>      <span class="k">endif</span>
<a name="ln-4244"></a><span class="k">      if</span><span class="p">(</span><span class="n">icount</span><span class="p">.</span><span class="n">ge</span><span class="p">.</span><span class="n">range_local</span><span class="p">(</span><span class="mi">1</span><span class="p">).</span><span class="nb">and</span><span class="p">.</span><span class="n">icount</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="n">range_local</span><span class="p">(</span><span class="mi">2</span><span class="p">))</span><span class="k">then</span>    <span class="c">! check if this is an instance to change or keep</span>
<a name="ln-4245"></a>         <span class="n">ichange</span><span class="o">=</span><span class="n">ichange</span><span class="o">+</span><span class="mi">1</span>
<a name="ln-4246"></a>         <span class="k">if</span><span class="p">(</span><span class="n">len_new</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                          <span class="c">! put in new string</span>
<a name="ln-4247"></a>            <span class="n">newline</span><span class="o">=</span><span class="n">newline</span><span class="p">(:</span><span class="n">iichar</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span><span class="o">//</span><span class="n">new_local</span><span class="p">(:</span><span class="n">len_new</span><span class="p">)</span>
<a name="ln-4248"></a>            <span class="n">iichar</span><span class="o">=</span><span class="n">iichar</span><span class="o">+</span><span class="n">len_new</span>
<a name="ln-4249"></a>         <span class="k">endif</span>
<a name="ln-4250"></a><span class="k">      else</span>
<a name="ln-4251"></a><span class="k">         if</span><span class="p">(</span><span class="n">len_old</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                          <span class="c">! put in copy of old string</span>
<a name="ln-4252"></a>            <span class="n">newline</span><span class="o">=</span><span class="n">newline</span><span class="p">(:</span><span class="n">iichar</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span><span class="o">//</span><span class="n">old_local</span><span class="p">(:</span><span class="n">len_old</span><span class="p">)</span>
<a name="ln-4253"></a>            <span class="n">iichar</span><span class="o">=</span><span class="n">iichar</span><span class="o">+</span><span class="n">len_old</span>
<a name="ln-4254"></a>         <span class="k">endif</span>
<a name="ln-4255"></a><span class="k">      endif</span>
<a name="ln-4256"></a><span class="k">      </span><span class="n">ic</span><span class="o">=</span><span class="n">ind</span><span class="o">+</span><span class="n">len_old</span>
<a name="ln-4257"></a>   <span class="k">enddo </span><span class="n">loop</span>
<a name="ln-4258"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4259"></a>   <span class="k">select case</span> <span class="p">(</span><span class="n">ichange</span><span class="p">)</span>
<a name="ln-4260"></a>   <span class="k">case</span> <span class="p">(</span><span class="mi">0</span><span class="p">)</span>                                            <span class="c">! there were no changes made to the window</span>
<a name="ln-4261"></a>      <span class="n">newline</span><span class="o">=</span><span class="n">targetline</span>                               <span class="c">! if no changes made output should be input</span>
<a name="ln-4262"></a>   <span class="k">case </span><span class="n">default</span>
<a name="ln-4263"></a>      <span class="k">if</span><span class="p">(</span><span class="n">ic</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="nb">len</span><span class="p">(</span><span class="n">targetline</span><span class="p">))</span><span class="k">then</span>                    <span class="c">! if there is more after last change on original line add it</span>
<a name="ln-4264"></a>         <span class="n">newline</span><span class="o">=</span><span class="n">newline</span><span class="p">(:</span><span class="n">iichar</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span><span class="o">//</span><span class="n">targetline</span><span class="p">(</span><span class="n">ic</span><span class="p">:</span><span class="nb">max</span><span class="p">(</span><span class="n">ic</span><span class="p">,</span><span class="n">original_input_length</span><span class="p">))</span>
<a name="ln-4265"></a>      <span class="k">endif</span>
<a name="ln-4266"></a><span class="k">   end select</span>
<a name="ln-4267"></a><span class="k">   if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">ierr</span><span class="p">))</span><span class="n">ierr</span><span class="o">=</span><span class="n">ichange</span>
<a name="ln-4268"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4269"></a><span class="k">end function </span><span class="n">replace_str</span>
<a name="ln-4270"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-4271"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()=</span>
<a name="ln-4272"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-4273"></a><span class="c">!&gt;</span>
<a name="ln-4274"></a><span class="c">!!##NAME</span>
<a name="ln-4275"></a><span class="c">!!     quote(3f) - [M_CLI2:QUOTES] add quotes to string as if written with</span>
<a name="ln-4276"></a><span class="c">!!     list-directed input</span>
<a name="ln-4277"></a><span class="c">!!     (LICENSE:PD)</span>
<a name="ln-4278"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-4279"></a><span class="c">!!</span>
<a name="ln-4280"></a><span class="c">!!   function quote(str,mode,clip) result (quoted_str)</span>
<a name="ln-4281"></a><span class="c">!!</span>
<a name="ln-4282"></a><span class="c">!!    character(len=*),intent(in)          :: str</span>
<a name="ln-4283"></a><span class="c">!!    character(len=*),optional,intent(in) :: mode</span>
<a name="ln-4284"></a><span class="c">!!    logical,optional,intent(in)          :: clip</span>
<a name="ln-4285"></a><span class="c">!!    character(len=:),allocatable         :: quoted_str</span>
<a name="ln-4286"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-4287"></a><span class="c">!!    Add quotes to a CHARACTER variable as if it was written using</span>
<a name="ln-4288"></a><span class="c">!!    list-directed input. This is particularly useful for processing</span>
<a name="ln-4289"></a><span class="c">!!    strings to add to CSV files.</span>
<a name="ln-4290"></a><span class="c">!!</span>
<a name="ln-4291"></a><span class="c">!!##OPTIONS</span>
<a name="ln-4292"></a><span class="c">!!    str         input string to add quotes to, using the rules of</span>
<a name="ln-4293"></a><span class="c">!!                list-directed input (single quotes are replaced by two</span>
<a name="ln-4294"></a><span class="c">!!                adjacent quotes)</span>
<a name="ln-4295"></a><span class="c">!!    mode        alternate quoting methods are supported:</span>
<a name="ln-4296"></a><span class="c">!!</span>
<a name="ln-4297"></a><span class="c">!!                   DOUBLE   default. replace quote with double quotes</span>
<a name="ln-4298"></a><span class="c">!!                   ESCAPE   replace quotes with backslash-quote instead</span>
<a name="ln-4299"></a><span class="c">!!                            of double quotes</span>
<a name="ln-4300"></a><span class="c">!!</span>
<a name="ln-4301"></a><span class="c">!!    clip        default is to trim leading and trailing spaces from the</span>
<a name="ln-4302"></a><span class="c">!!                string. If CLIP</span>
<a name="ln-4303"></a><span class="c">!!                is .FALSE. spaces are not trimmed</span>
<a name="ln-4304"></a><span class="c">!!</span>
<a name="ln-4305"></a><span class="c">!!##RESULT</span>
<a name="ln-4306"></a><span class="c">!!    quoted_str  The output string, which is based on adding quotes to STR.</span>
<a name="ln-4307"></a><span class="c">!!##EXAMPLE</span>
<a name="ln-4308"></a><span class="c">!!</span>
<a name="ln-4309"></a><span class="c">!! Sample program:</span>
<a name="ln-4310"></a><span class="c">!!</span>
<a name="ln-4311"></a><span class="c">!!     program demo_quote</span>
<a name="ln-4312"></a><span class="c">!!     use M_CLI2, only : quote</span>
<a name="ln-4313"></a><span class="c">!!     implicit none</span>
<a name="ln-4314"></a><span class="c">!!     character(len=:),allocatable :: str</span>
<a name="ln-4315"></a><span class="c">!!     character(len=1024)          :: msg</span>
<a name="ln-4316"></a><span class="c">!!     integer                      :: ios</span>
<a name="ln-4317"></a><span class="c">!!     character(len=80)            :: inline</span>
<a name="ln-4318"></a><span class="c">!!        do</span>
<a name="ln-4319"></a><span class="c">!!           write(*,&#39;(a)&#39;,advance=&#39;no&#39;)&#39;Enter test string:&#39;</span>
<a name="ln-4320"></a><span class="c">!!           read(*,&#39;(a)&#39;,iostat=ios,iomsg=msg)inline</span>
<a name="ln-4321"></a><span class="c">!!           if(ios.ne.0)then</span>
<a name="ln-4322"></a><span class="c">!!              write(*,*)trim(inline)</span>
<a name="ln-4323"></a><span class="c">!!              exit</span>
<a name="ln-4324"></a><span class="c">!!           endif</span>
<a name="ln-4325"></a><span class="c">!!</span>
<a name="ln-4326"></a><span class="c">!!           ! the original string</span>
<a name="ln-4327"></a><span class="c">!!           write(*,&#39;(a)&#39;)&#39;ORIGINAL     [&#39;//trim(inline)//&#39;]&#39;</span>
<a name="ln-4328"></a><span class="c">!!</span>
<a name="ln-4329"></a><span class="c">!!           ! the string processed by quote(3f)</span>
<a name="ln-4330"></a><span class="c">!!           str=quote(inline)</span>
<a name="ln-4331"></a><span class="c">!!           write(*,&#39;(a)&#39;)&#39;QUOTED     [&#39;//str//&#39;]&#39;</span>
<a name="ln-4332"></a><span class="c">!!</span>
<a name="ln-4333"></a><span class="c">!!           ! write the string list-directed to compare the results</span>
<a name="ln-4334"></a><span class="c">!!           write(*,&#39;(a)&#39;,iostat=ios,iomsg=msg) &#39;LIST DIRECTED:&#39;</span>
<a name="ln-4335"></a><span class="c">!!           write(*,*,iostat=ios,iomsg=msg,delim=&#39;none&#39;) inline</span>
<a name="ln-4336"></a><span class="c">!!           write(*,*,iostat=ios,iomsg=msg,delim=&#39;quote&#39;) inline</span>
<a name="ln-4337"></a><span class="c">!!           write(*,*,iostat=ios,iomsg=msg,delim=&#39;apostrophe&#39;) inline</span>
<a name="ln-4338"></a><span class="c">!!        enddo</span>
<a name="ln-4339"></a><span class="c">!!     end program demo_quote</span>
<a name="ln-4340"></a><span class="c">!!</span>
<a name="ln-4341"></a><span class="c">!!##AUTHOR</span>
<a name="ln-4342"></a><span class="c">!!    John S. Urban</span>
<a name="ln-4343"></a><span class="c">!!##LICENSE</span>
<a name="ln-4344"></a><span class="c">!!    Public Domain</span>
<a name="ln-4345"></a><span class="k">function </span><span class="n">quote</span><span class="p">(</span><span class="n">str</span><span class="p">,</span><span class="n">mode</span><span class="p">,</span><span class="n">clip</span><span class="p">)</span> <span class="k">result</span> <span class="p">(</span><span class="n">quoted_str</span><span class="p">)</span>
<a name="ln-4346"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">str</span>                <span class="c">! the string to be quoted</span>
<a name="ln-4347"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">optional</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">mode</span>
<a name="ln-4348"></a><span class="kt">logical</span><span class="p">,</span><span class="k">optional</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">clip</span>
<a name="ln-4349"></a><span class="kt">logical</span>                              <span class="kd">::</span> <span class="n">clip_local</span>
<a name="ln-4350"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>         <span class="kd">::</span> <span class="n">quoted_str</span>
<a name="ln-4351"></a>
<a name="ln-4352"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">1</span><span class="p">),</span><span class="k">parameter</span>           <span class="kd">::</span> <span class="n">double_quote</span> <span class="o">=</span> <span class="s1">&#39;&quot;&#39;</span>
<a name="ln-4353"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">20</span><span class="p">)</span>                    <span class="kd">::</span> <span class="n">local_mode</span>
<a name="ln-4354"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4355"></a>   <span class="n">local_mode</span><span class="o">=</span><span class="n">merge_str</span><span class="p">(</span><span class="n">mode</span><span class="p">,</span><span class="s1">&#39;DOUBLE&#39;</span><span class="p">,</span><span class="nb">present</span><span class="p">(</span><span class="n">mode</span><span class="p">))</span>
<a name="ln-4356"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">clip</span><span class="p">))</span><span class="k">then</span>
<a name="ln-4357"></a><span class="k">      </span><span class="n">clip_local</span><span class="o">=</span><span class="n">clip</span>
<a name="ln-4358"></a>   <span class="k">else</span>
<a name="ln-4359"></a><span class="k">      </span><span class="n">clip_local</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>
<a name="ln-4360"></a>   <span class="k">endif</span>
<a name="ln-4361"></a><span class="k">   if</span><span class="p">(</span><span class="n">clip_local</span><span class="p">)</span><span class="k">then</span>
<a name="ln-4362"></a><span class="k">      </span><span class="n">quoted_str</span><span class="o">=</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">str</span><span class="p">)</span>
<a name="ln-4363"></a>   <span class="k">else</span>
<a name="ln-4364"></a><span class="k">      </span><span class="n">quoted_str</span><span class="o">=</span><span class="n">str</span>
<a name="ln-4365"></a>   <span class="k">endif</span>
<a name="ln-4366"></a><span class="k">   select case</span><span class="p">(</span><span class="n">lower</span><span class="p">(</span><span class="n">local_mode</span><span class="p">))</span>
<a name="ln-4367"></a>   <span class="k">case</span><span class="p">(</span><span class="s1">&#39;double&#39;</span><span class="p">)</span>
<a name="ln-4368"></a>      <span class="n">quoted_str</span><span class="o">=</span><span class="n">double_quote</span><span class="o">//</span><span class="nb">trim</span><span class="p">(</span><span class="n">replace_str</span><span class="p">(</span><span class="n">quoted_str</span><span class="p">,</span><span class="s1">&#39;&quot;&#39;</span><span class="p">,</span><span class="s1">&#39;&quot;&quot;&#39;</span><span class="p">))</span><span class="o">//</span><span class="n">double_quote</span>
<a name="ln-4369"></a>   <span class="k">case</span><span class="p">(</span><span class="s1">&#39;escape&#39;</span><span class="p">)</span>
<a name="ln-4370"></a>      <span class="n">quoted_str</span><span class="o">=</span><span class="n">double_quote</span><span class="o">//</span><span class="nb">trim</span><span class="p">(</span><span class="n">replace_str</span><span class="p">(</span><span class="n">quoted_str</span><span class="p">,</span><span class="s1">&#39;&quot;&#39;</span><span class="p">,</span><span class="s1">&#39;\&quot;&#39;</span><span class="p">))</span><span class="o">//</span><span class="n">double_quote</span>
<a name="ln-4371"></a>   <span class="k">case </span><span class="n">default</span>
<a name="ln-4372"></a>      <span class="k">call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*quote* ERROR: unknown quote mode &#39;</span><span class="p">,</span><span class="n">local_mode</span><span class="p">)</span>
<a name="ln-4373"></a>      <span class="n">quoted_str</span><span class="o">=</span><span class="n">str</span>
<a name="ln-4374"></a>   <span class="k">end select</span>
<a name="ln-4375"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4376"></a><span class="k">end function </span><span class="n">quote</span>
<a name="ln-4377"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-4378"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()=</span>
<a name="ln-4379"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-4380"></a><span class="c">!&gt;</span>
<a name="ln-4381"></a><span class="c">!!##NAME</span>
<a name="ln-4382"></a><span class="c">!!     unquote(3f) - [M_CLI2:QUOTES] remove quotes from string as if read</span>
<a name="ln-4383"></a><span class="c">!!     with list-directed input</span>
<a name="ln-4384"></a><span class="c">!!     (LICENSE:PD)</span>
<a name="ln-4385"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-4386"></a><span class="c">!!</span>
<a name="ln-4387"></a><span class="c">!!   pure function unquote(quoted_str,esc) result (unquoted_str)</span>
<a name="ln-4388"></a><span class="c">!!</span>
<a name="ln-4389"></a><span class="c">!!    character(len=*),intent(in)          :: quoted_str</span>
<a name="ln-4390"></a><span class="c">!!    character(len=1),optional,intent(in) :: esc</span>
<a name="ln-4391"></a><span class="c">!!    character(len=:),allocatable         :: unquoted_str</span>
<a name="ln-4392"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-4393"></a><span class="c">!!    Remove quotes from a CHARACTER variable as if it was read using</span>
<a name="ln-4394"></a><span class="c">!!    list-directed input. This is particularly useful for processing</span>
<a name="ln-4395"></a><span class="c">!!    tokens read from input such as CSV files.</span>
<a name="ln-4396"></a><span class="c">!!</span>
<a name="ln-4397"></a><span class="c">!!    Fortran can now read using list-directed input from an internal file,</span>
<a name="ln-4398"></a><span class="c">!!    which should handle quoted strings, but list-directed input does not</span>
<a name="ln-4399"></a><span class="c">!!    support escape characters, which UNQUOTE(3f) does.</span>
<a name="ln-4400"></a><span class="c">!!##OPTIONS</span>
<a name="ln-4401"></a><span class="c">!!    quoted_str  input string to remove quotes from, using the rules of</span>
<a name="ln-4402"></a><span class="c">!!                list-directed input (two adjacent quotes inside a quoted</span>
<a name="ln-4403"></a><span class="c">!!                region are replaced by a single quote, a single quote or</span>
<a name="ln-4404"></a><span class="c">!!                double quote is selected as the delimiter based on which</span>
<a name="ln-4405"></a><span class="c">!!                is encountered first going from left to right, ...)</span>
<a name="ln-4406"></a><span class="c">!!    esc         optional character used to protect the next quote</span>
<a name="ln-4407"></a><span class="c">!!                character from being processed as a quote, but simply as</span>
<a name="ln-4408"></a><span class="c">!!                a plain character.</span>
<a name="ln-4409"></a><span class="c">!!##RESULT</span>
<a name="ln-4410"></a><span class="c">!!    unquoted_str  The output string, which is based on removing quotes</span>
<a name="ln-4411"></a><span class="c">!!                  from quoted_str.</span>
<a name="ln-4412"></a><span class="c">!!##EXAMPLE</span>
<a name="ln-4413"></a><span class="c">!!</span>
<a name="ln-4414"></a><span class="c">!! Sample program:</span>
<a name="ln-4415"></a><span class="c">!!</span>
<a name="ln-4416"></a><span class="c">!!       program demo_unquote</span>
<a name="ln-4417"></a><span class="c">!!       use M_CLI2, only : unquote</span>
<a name="ln-4418"></a><span class="c">!!       implicit none</span>
<a name="ln-4419"></a><span class="c">!!       character(len=128)           :: quoted_str</span>
<a name="ln-4420"></a><span class="c">!!       character(len=:),allocatable :: unquoted_str</span>
<a name="ln-4421"></a><span class="c">!!       character(len=1),parameter   :: esc=&#39;\&#39;</span>
<a name="ln-4422"></a><span class="c">!!       character(len=1024)          :: msg</span>
<a name="ln-4423"></a><span class="c">!!       integer                      :: ios</span>
<a name="ln-4424"></a><span class="c">!!       character(len=1024)          :: dummy</span>
<a name="ln-4425"></a><span class="c">!!       do</span>
<a name="ln-4426"></a><span class="c">!!          write(*,&#39;(a)&#39;,advance=&#39;no&#39;)&#39;Enter test string:&#39;</span>
<a name="ln-4427"></a><span class="c">!!          read(*,&#39;(a)&#39;,iostat=ios,iomsg=msg)quoted_str</span>
<a name="ln-4428"></a><span class="c">!!          if(ios.ne.0)then</span>
<a name="ln-4429"></a><span class="c">!!             write(*,*)trim(msg)</span>
<a name="ln-4430"></a><span class="c">!!             exit</span>
<a name="ln-4431"></a><span class="c">!!          endif</span>
<a name="ln-4432"></a><span class="c">!!</span>
<a name="ln-4433"></a><span class="c">!!          ! the original string</span>
<a name="ln-4434"></a><span class="c">!!          write(*,&#39;(a)&#39;)&#39;QUOTED       [&#39;//trim(quoted_str)//&#39;]&#39;</span>
<a name="ln-4435"></a><span class="c">!!</span>
<a name="ln-4436"></a><span class="c">!!          ! the string processed by unquote(3f)</span>
<a name="ln-4437"></a><span class="c">!!          unquoted_str=unquote(trim(quoted_str),esc)</span>
<a name="ln-4438"></a><span class="c">!!          write(*,&#39;(a)&#39;)&#39;UNQUOTED     [&#39;//unquoted_str//&#39;]&#39;</span>
<a name="ln-4439"></a><span class="c">!!</span>
<a name="ln-4440"></a><span class="c">!!          ! read the string list-directed to compare the results</span>
<a name="ln-4441"></a><span class="c">!!          read(quoted_str,*,iostat=ios,iomsg=msg)dummy</span>
<a name="ln-4442"></a><span class="c">!!          if(ios.ne.0)then</span>
<a name="ln-4443"></a><span class="c">!!             write(*,*)trim(msg)</span>
<a name="ln-4444"></a><span class="c">!!          else</span>
<a name="ln-4445"></a><span class="c">!!             write(*,&#39;(a)&#39;)&#39;LIST DIRECTED[&#39;//trim(dummy)//&#39;]&#39;</span>
<a name="ln-4446"></a><span class="c">!!          endif</span>
<a name="ln-4447"></a><span class="c">!!       enddo</span>
<a name="ln-4448"></a><span class="c">!!       end program demo_unquote</span>
<a name="ln-4449"></a><span class="c">!!</span>
<a name="ln-4450"></a><span class="c">!!##AUTHOR</span>
<a name="ln-4451"></a><span class="c">!!    John S. Urban</span>
<a name="ln-4452"></a><span class="c">!!##LICENSE</span>
<a name="ln-4453"></a><span class="c">!!    Public Domain</span>
<a name="ln-4454"></a><span class="k">pure function </span><span class="n">unquote</span><span class="p">(</span><span class="n">quoted_str</span><span class="p">,</span><span class="n">esc</span><span class="p">)</span> <span class="k">result</span> <span class="p">(</span><span class="n">unquoted_str</span><span class="p">)</span>
<a name="ln-4455"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">quoted_str</span>              <span class="c">! the string to be unquoted</span>
<a name="ln-4456"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">1</span><span class="p">),</span><span class="k">optional</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">esc</span>                     <span class="c">! escape character</span>
<a name="ln-4457"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>         <span class="kd">::</span> <span class="n">unquoted_str</span>
<a name="ln-4458"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">inlen</span>
<a name="ln-4459"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">1</span><span class="p">),</span><span class="k">parameter</span>           <span class="kd">::</span> <span class="n">single_quote</span> <span class="o">=</span> <span class="s2">&quot;&#39;&quot;</span>
<a name="ln-4460"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">1</span><span class="p">),</span><span class="k">parameter</span>           <span class="kd">::</span> <span class="n">double_quote</span> <span class="o">=</span> <span class="s1">&#39;&quot;&#39;</span>
<a name="ln-4461"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">quote</span>                   <span class="c">! whichever quote is to be used</span>
<a name="ln-4462"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">before</span>
<a name="ln-4463"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">current</span>
<a name="ln-4464"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">iesc</span>
<a name="ln-4465"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">iput</span>
<a name="ln-4466"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">i</span>
<a name="ln-4467"></a><span class="kt">logical</span>                              <span class="kd">::</span> <span class="n">inside</span>
<a name="ln-4468"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4469"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">esc</span><span class="p">))</span><span class="k">then</span>                           <span class="c">! select escape character as specified character or special value meaning not set</span>
<a name="ln-4470"></a>      <span class="n">iesc</span><span class="o">=</span><span class="nb">ichar</span><span class="p">(</span><span class="n">esc</span><span class="p">)</span>                             <span class="c">! allow for an escape character</span>
<a name="ln-4471"></a>   <span class="k">else</span>
<a name="ln-4472"></a><span class="k">      </span><span class="n">iesc</span><span class="o">=-</span><span class="mi">1</span>                                     <span class="c">! set to value that matches no character</span>
<a name="ln-4473"></a>   <span class="k">endif</span>
<a name="ln-4474"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4475"></a>   <span class="n">inlen</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">quoted_str</span><span class="p">)</span>                          <span class="c">! find length of input string</span>
<a name="ln-4476"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">unquoted_str</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">unquoted_str</span><span class="p">)</span>
<a name="ln-4477"></a>   <span class="k">allocate</span><span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="n">inlen</span><span class="p">)</span> <span class="kd">::</span> <span class="n">unquoted_str</span><span class="p">)</span> <span class="c">! initially make output string length of input string</span>
<a name="ln-4478"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4479"></a>   <span class="k">if</span><span class="p">(</span><span class="n">inlen</span><span class="p">.</span><span class="n">ge</span><span class="p">.</span><span class="mi">1</span><span class="p">)</span><span class="k">then</span>                             <span class="c">! double_quote is the default quote unless the first character is single_quote</span>
<a name="ln-4480"></a>      <span class="k">if</span><span class="p">(</span><span class="n">quoted_str</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="mi">1</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="n">single_quote</span><span class="p">)</span><span class="k">then</span>
<a name="ln-4481"></a><span class="k">         </span><span class="n">quote</span><span class="o">=</span><span class="nb">ichar</span><span class="p">(</span><span class="n">single_quote</span><span class="p">)</span>
<a name="ln-4482"></a>      <span class="k">else</span>
<a name="ln-4483"></a><span class="k">         </span><span class="n">quote</span><span class="o">=</span><span class="nb">ichar</span><span class="p">(</span><span class="n">double_quote</span><span class="p">)</span>
<a name="ln-4484"></a>      <span class="k">endif</span>
<a name="ln-4485"></a><span class="k">   else</span>
<a name="ln-4486"></a><span class="k">      </span><span class="n">quote</span><span class="o">=</span><span class="nb">ichar</span><span class="p">(</span><span class="n">double_quote</span><span class="p">)</span>
<a name="ln-4487"></a>   <span class="k">endif</span>
<a name="ln-4488"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4489"></a>   <span class="n">before</span><span class="o">=-</span><span class="mi">2</span>                                      <span class="c">! initially set previous character to impossible value</span>
<a name="ln-4490"></a>   <span class="n">unquoted_str</span><span class="p">(:)</span><span class="o">=</span><span class="s1">&#39;&#39;</span>                             <span class="c">! initialize output string to null string</span>
<a name="ln-4491"></a>   <span class="n">iput</span><span class="o">=</span><span class="mi">1</span>
<a name="ln-4492"></a>   <span class="n">inside</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>
<a name="ln-4493"></a>   <span class="n">STEPTHROUGH</span><span class="p">:</span> <span class="k">do </span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">inlen</span>
<a name="ln-4494"></a>      <span class="n">current</span><span class="o">=</span><span class="nb">ichar</span><span class="p">(</span><span class="n">quoted_str</span><span class="p">(</span><span class="n">i</span><span class="p">:</span><span class="n">i</span><span class="p">))</span>
<a name="ln-4495"></a>      <span class="k">if</span><span class="p">(</span><span class="n">before</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="n">iesc</span><span class="p">)</span><span class="k">then</span>                      <span class="c">! if previous character was escape use current character unconditionally</span>
<a name="ln-4496"></a>           <span class="n">iput</span><span class="o">=</span><span class="n">iput</span><span class="o">-</span><span class="mi">1</span>                            <span class="c">! backup</span>
<a name="ln-4497"></a>           <span class="n">unquoted_str</span><span class="p">(</span><span class="n">iput</span><span class="p">:</span><span class="n">iput</span><span class="p">)</span><span class="o">=</span><span class="nb">char</span><span class="p">(</span><span class="n">current</span><span class="p">)</span>
<a name="ln-4498"></a>           <span class="n">iput</span><span class="o">=</span><span class="n">iput</span><span class="o">+</span><span class="mi">1</span>
<a name="ln-4499"></a>           <span class="n">before</span><span class="o">=-</span><span class="mi">2</span>                              <span class="c">! this could be second esc or quote</span>
<a name="ln-4500"></a>      <span class="n">elseif</span><span class="p">(</span><span class="n">current</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="n">quote</span><span class="p">)</span><span class="k">then</span>                <span class="c">! if current is a quote it depends on whether previous character was a quote</span>
<a name="ln-4501"></a>         <span class="k">if</span><span class="p">(</span><span class="n">before</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="n">quote</span><span class="p">)</span><span class="k">then</span>
<a name="ln-4502"></a><span class="k">           </span><span class="n">unquoted_str</span><span class="p">(</span><span class="n">iput</span><span class="p">:</span><span class="n">iput</span><span class="p">)</span><span class="o">=</span><span class="nb">char</span><span class="p">(</span><span class="n">quote</span><span class="p">)</span>    <span class="c">! this is second quote so retain it</span>
<a name="ln-4503"></a>           <span class="n">iput</span><span class="o">=</span><span class="n">iput</span><span class="o">+</span><span class="mi">1</span>
<a name="ln-4504"></a>           <span class="n">before</span><span class="o">=-</span><span class="mi">2</span>
<a name="ln-4505"></a>         <span class="n">elseif</span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="n">inside</span><span class="p">.</span><span class="nb">and</span><span class="p">.</span><span class="n">before</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="n">iesc</span><span class="p">)</span><span class="k">then</span>
<a name="ln-4506"></a><span class="k">            </span><span class="n">inside</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.</span>
<a name="ln-4507"></a>         <span class="k">else</span>                                     <span class="c">! this is first quote so ignore it except remember it in case next is a quote</span>
<a name="ln-4508"></a>            <span class="n">before</span><span class="o">=</span><span class="n">current</span>
<a name="ln-4509"></a>         <span class="k">endif</span>
<a name="ln-4510"></a><span class="k">      else</span>
<a name="ln-4511"></a><span class="k">         </span><span class="n">unquoted_str</span><span class="p">(</span><span class="n">iput</span><span class="p">:</span><span class="n">iput</span><span class="p">)</span><span class="o">=</span><span class="nb">char</span><span class="p">(</span><span class="n">current</span><span class="p">)</span>
<a name="ln-4512"></a>         <span class="n">iput</span><span class="o">=</span><span class="n">iput</span><span class="o">+</span><span class="mi">1</span>
<a name="ln-4513"></a>         <span class="n">before</span><span class="o">=</span><span class="n">current</span>
<a name="ln-4514"></a>      <span class="k">endif</span>
<a name="ln-4515"></a><span class="k">   enddo </span><span class="n">STEPTHROUGH</span>
<a name="ln-4516"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4517"></a>   <span class="n">unquoted_str</span><span class="o">=</span><span class="n">unquoted_str</span><span class="p">(:</span><span class="n">iput</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span>
<a name="ln-4518"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-4519"></a><span class="k">end function </span><span class="n">unquote</span>
<a name="ln-4520"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-4521"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-4522"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-4523"></a><span class="k">function </span><span class="n">i2s</span><span class="p">(</span><span class="n">ivalue</span><span class="p">,</span><span class="n">fmt</span><span class="p">)</span> <span class="k">result</span><span class="p">(</span><span class="n">outstr</span><span class="p">)</span>
<a name="ln-4524"></a>
<a name="ln-4525"></a><span class="c">! ident_22=&quot;@(#)M_CLI2::i2s(3fp): private function returns string given integer value&quot;</span>
<a name="ln-4526"></a>
<a name="ln-4527"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>           <span class="kd">::</span> <span class="n">ivalue</span>                         <span class="c">! input value to convert to a string</span>
<a name="ln-4528"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">fmt</span>
<a name="ln-4529"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">outstr</span>                         <span class="c">! output string to generate</span>
<a name="ln-4530"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">80</span><span class="p">)</span>            <span class="kd">::</span> <span class="n">string</span>
<a name="ln-4531"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">fmt</span><span class="p">))</span><span class="k">then</span>
<a name="ln-4532"></a><span class="k">      call </span><span class="n">value_to_string</span><span class="p">(</span><span class="n">ivalue</span><span class="p">,</span><span class="n">string</span><span class="p">,</span><span class="n">fmt</span><span class="o">=</span><span class="n">fmt</span><span class="p">)</span>
<a name="ln-4533"></a>   <span class="k">else</span>
<a name="ln-4534"></a><span class="k">      call </span><span class="n">value_to_string</span><span class="p">(</span><span class="n">ivalue</span><span class="p">,</span><span class="n">string</span><span class="p">)</span>
<a name="ln-4535"></a>   <span class="k">endif</span>
<a name="ln-4536"></a><span class="k">   </span><span class="n">outstr</span><span class="o">=</span><span class="nb">trim</span><span class="p">(</span><span class="n">string</span><span class="p">)</span>
<a name="ln-4537"></a><span class="k">end function </span><span class="n">i2s</span>
<a name="ln-4538"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-4539"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-4540"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-4541"></a><span class="c">!&gt;</span>
<a name="ln-4542"></a><span class="c">!!##NAME</span>
<a name="ln-4543"></a><span class="c">!!    merge_str(3f) - [M_CLI2:LENGTH] pads strings to same length and then</span>
<a name="ln-4544"></a><span class="c">!!                    calls MERGE(3f)</span>
<a name="ln-4545"></a><span class="c">!!    (LICENSE:PD)</span>
<a name="ln-4546"></a><span class="c">!!</span>
<a name="ln-4547"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-4548"></a><span class="c">!!</span>
<a name="ln-4549"></a><span class="c">!!    function merge_str(str1,str2,expr) result(strout)</span>
<a name="ln-4550"></a><span class="c">!!</span>
<a name="ln-4551"></a><span class="c">!!     character(len=*),intent(in),optional :: str1</span>
<a name="ln-4552"></a><span class="c">!!     character(len=*),intent(in),optional :: str2</span>
<a name="ln-4553"></a><span class="c">!!     logical,intent(in)              :: expr</span>
<a name="ln-4554"></a><span class="c">!!     character(len=:),allocatable    :: strout</span>
<a name="ln-4555"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-4556"></a><span class="c">!!    merge_str(3f) pads the shorter of str1 and str2 to the longest length</span>
<a name="ln-4557"></a><span class="c">!!    of str1 and str2 and then calls MERGE(padded_str1,padded_str2,expr).</span>
<a name="ln-4558"></a><span class="c">!!    It trims trailing spaces off the result and returns the trimmed</span>
<a name="ln-4559"></a><span class="c">!!    string. This makes it easier to call MERGE(3f) with strings, as</span>
<a name="ln-4560"></a><span class="c">!!    MERGE(3f) requires the strings to be the same length.</span>
<a name="ln-4561"></a><span class="c">!!</span>
<a name="ln-4562"></a><span class="c">!!    NOTE: STR1 and STR2 are always required even though declared optional.</span>
<a name="ln-4563"></a><span class="c">!!          this is so the call &quot;STR_MERGE(A,B,present(A))&quot; is a valid call.</span>
<a name="ln-4564"></a><span class="c">!!          The parameters STR1 and STR2 when they are optional parameters</span>
<a name="ln-4565"></a><span class="c">!!          can be passed to a procedure if the options are optional on the</span>
<a name="ln-4566"></a><span class="c">!!          called procedure.</span>
<a name="ln-4567"></a><span class="c">!!</span>
<a name="ln-4568"></a><span class="c">!!##OPTIONS</span>
<a name="ln-4569"></a><span class="c">!!    STR1    string to return if the logical expression EXPR is true</span>
<a name="ln-4570"></a><span class="c">!!    STR2    string to return if the logical expression EXPR is false</span>
<a name="ln-4571"></a><span class="c">!!    EXPR    logical expression to evaluate to determine whether to return</span>
<a name="ln-4572"></a><span class="c">!!            STR1 when true, and STR2 when false.</span>
<a name="ln-4573"></a><span class="c">!!##RESULT</span>
<a name="ln-4574"></a><span class="c">!!     MERGE_STR  a trimmed string is returned that is otherwise the value</span>
<a name="ln-4575"></a><span class="c">!!                of STR1 or STR2, depending on the logical expression EXPR.</span>
<a name="ln-4576"></a><span class="c">!!</span>
<a name="ln-4577"></a><span class="c">!!##EXAMPLES</span>
<a name="ln-4578"></a><span class="c">!!</span>
<a name="ln-4579"></a><span class="c">!! Sample Program:</span>
<a name="ln-4580"></a><span class="c">!!</span>
<a name="ln-4581"></a><span class="c">!!     program demo_merge_str</span>
<a name="ln-4582"></a><span class="c">!!     use M_CLI2, only : merge_str</span>
<a name="ln-4583"></a><span class="c">!!     implicit none</span>
<a name="ln-4584"></a><span class="c">!!     character(len=:), allocatable :: answer</span>
<a name="ln-4585"></a><span class="c">!!        answer=merge_str(&#39;first string&#39;, &#39;second string is longer&#39;,10.eq.10)</span>
<a name="ln-4586"></a><span class="c">!!        write(*,&#39;(&quot;[&quot;,a,&quot;]&quot;)&#39;) answer</span>
<a name="ln-4587"></a><span class="c">!!        answer=merge_str(&#39;first string&#39;, &#39;second string is longer&#39;,10.ne.10)</span>
<a name="ln-4588"></a><span class="c">!!        write(*,&#39;(&quot;[&quot;,a,&quot;]&quot;)&#39;) answer</span>
<a name="ln-4589"></a><span class="c">!!     end program demo_merge_str</span>
<a name="ln-4590"></a><span class="c">!!</span>
<a name="ln-4591"></a><span class="c">!!   Expected output</span>
<a name="ln-4592"></a><span class="c">!!</span>
<a name="ln-4593"></a><span class="c">!!     [first string]</span>
<a name="ln-4594"></a><span class="c">!!     [second string is longer]</span>
<a name="ln-4595"></a><span class="c">!!##AUTHOR</span>
<a name="ln-4596"></a><span class="c">!!    John S. Urban</span>
<a name="ln-4597"></a><span class="c">!!##LICENSE</span>
<a name="ln-4598"></a><span class="c">!!    Public Domain</span>
<a name="ln-4599"></a><span class="k">function </span><span class="n">merge_str</span><span class="p">(</span><span class="n">str1</span><span class="p">,</span><span class="n">str2</span><span class="p">,</span><span class="n">expr</span><span class="p">)</span> <span class="k">result</span><span class="p">(</span><span class="n">strout</span><span class="p">)</span>
<a name="ln-4600"></a><span class="c">! for some reason the MERGE(3f) intrinsic requires the strings it compares to be of equal length</span>
<a name="ln-4601"></a><span class="c">! make an alias for MERGE(3f) that makes the lengths the same before doing the comparison by padding the shorter one with spaces</span>
<a name="ln-4602"></a>
<a name="ln-4603"></a><span class="c">! ident_23=&quot;@(#)M_CLI2::merge_str(3f): pads first and second arguments to MERGE(3f) to same length&quot;</span>
<a name="ln-4604"></a>
<a name="ln-4605"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">str1</span>
<a name="ln-4606"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">str2</span>
<a name="ln-4607"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>         <span class="kd">::</span> <span class="n">str1_local</span>
<a name="ln-4608"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>         <span class="kd">::</span> <span class="n">str2_local</span>
<a name="ln-4609"></a><span class="kt">logical</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>                   <span class="kd">::</span> <span class="n">expr</span>
<a name="ln-4610"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>         <span class="kd">::</span> <span class="n">strout</span>
<a name="ln-4611"></a><span class="kt">integer</span>                              <span class="kd">::</span> <span class="n">big</span>
<a name="ln-4612"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">str2</span><span class="p">))</span><span class="k">then</span>
<a name="ln-4613"></a><span class="k">      </span><span class="n">str2_local</span><span class="o">=</span><span class="n">str2</span>
<a name="ln-4614"></a>   <span class="k">else</span>
<a name="ln-4615"></a><span class="k">      </span><span class="n">str2_local</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-4616"></a>   <span class="k">endif</span>
<a name="ln-4617"></a><span class="k">   if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">str1</span><span class="p">))</span><span class="k">then</span>
<a name="ln-4618"></a><span class="k">      </span><span class="n">str1_local</span><span class="o">=</span><span class="n">str1</span>
<a name="ln-4619"></a>   <span class="k">else</span>
<a name="ln-4620"></a><span class="k">      </span><span class="n">str1_local</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-4621"></a>   <span class="k">endif</span>
<a name="ln-4622"></a><span class="k">   </span><span class="n">big</span><span class="o">=</span><span class="nb">max</span><span class="p">(</span><span class="nb">len</span><span class="p">(</span><span class="n">str1_local</span><span class="p">),</span><span class="nb">len</span><span class="p">(</span><span class="n">str2_local</span><span class="p">))</span>
<a name="ln-4623"></a>   <span class="c">! note: perhaps it would be better to warn or fail if an optional value that is not present is returned, instead of returning &#39;&#39;</span>
<a name="ln-4624"></a>   <span class="n">strout</span><span class="o">=</span><span class="nb">trim</span><span class="p">(</span><span class="nb">merge</span><span class="p">(</span><span class="n">lenset</span><span class="p">(</span><span class="n">str1_local</span><span class="p">,</span><span class="n">big</span><span class="p">),</span><span class="n">lenset</span><span class="p">(</span><span class="n">str2_local</span><span class="p">,</span><span class="n">big</span><span class="p">),</span><span class="n">expr</span><span class="p">))</span>
<a name="ln-4625"></a><span class="k">end function </span><span class="n">merge_str</span>
<a name="ln-4626"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-4627"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-4628"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-4629"></a><span class="c">!&gt;</span>
<a name="ln-4630"></a><span class="c">!!##NAME</span>
<a name="ln-4631"></a><span class="c">!!</span>
<a name="ln-4632"></a><span class="c">!!    decodebase(3f) - [M_CLI2:BASE] convert whole number string in base</span>
<a name="ln-4633"></a><span class="c">!!                     [2-36] to base 10 number</span>
<a name="ln-4634"></a><span class="c">!!    (LICENSE:PD)</span>
<a name="ln-4635"></a><span class="c">!!</span>
<a name="ln-4636"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-4637"></a><span class="c">!!</span>
<a name="ln-4638"></a><span class="c">!!   logical function decodebase(string,basein,out10)</span>
<a name="ln-4639"></a><span class="c">!!</span>
<a name="ln-4640"></a><span class="c">!!    character(len=*),intent(in)  :: string</span>
<a name="ln-4641"></a><span class="c">!!    integer,intent(in)           :: basein</span>
<a name="ln-4642"></a><span class="c">!!    integer,intent(out)          :: out10</span>
<a name="ln-4643"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-4644"></a><span class="c">!!</span>
<a name="ln-4645"></a><span class="c">!!    Convert a numeric string representing a whole number in base BASEIN</span>
<a name="ln-4646"></a><span class="c">!!    to base 10. The function returns FALSE if BASEIN is not in the range</span>
<a name="ln-4647"></a><span class="c">!!    [2..36] or if string STRING contains invalid characters in base BASEIN</span>
<a name="ln-4648"></a><span class="c">!!    or if result OUT10 is too big</span>
<a name="ln-4649"></a><span class="c">!!</span>
<a name="ln-4650"></a><span class="c">!!    The letters A,B,...,Z represent 10,11,...,36 in the base &gt; 10.</span>
<a name="ln-4651"></a><span class="c">!!</span>
<a name="ln-4652"></a><span class="c">!!##OPTIONS</span>
<a name="ln-4653"></a><span class="c">!!    string   input string. It represents a whole number in</span>
<a name="ln-4654"></a><span class="c">!!             the base specified by BASEIN unless BASEIN is set</span>
<a name="ln-4655"></a><span class="c">!!             to zero. When BASEIN is zero STRING is assumed to</span>
<a name="ln-4656"></a><span class="c">!!             be of the form BASE#VALUE where BASE represents</span>
<a name="ln-4657"></a><span class="c">!!             the function normally provided by BASEIN.</span>
<a name="ln-4658"></a><span class="c">!!    basein   base of input string; either 0 or from 2 to 36.</span>
<a name="ln-4659"></a><span class="c">!!    out10    output value in base 10</span>
<a name="ln-4660"></a><span class="c">!!</span>
<a name="ln-4661"></a><span class="c">!!##EXAMPLE</span>
<a name="ln-4662"></a><span class="c">!!</span>
<a name="ln-4663"></a><span class="c">!! Sample program:</span>
<a name="ln-4664"></a><span class="c">!!</span>
<a name="ln-4665"></a><span class="c">!!      program demo_decodebase</span>
<a name="ln-4666"></a><span class="c">!!      use M_CLI2, only : codebase, decodebase</span>
<a name="ln-4667"></a><span class="c">!!      implicit none</span>
<a name="ln-4668"></a><span class="c">!!      integer           :: ba,bd</span>
<a name="ln-4669"></a><span class="c">!!      character(len=40) :: x,y</span>
<a name="ln-4670"></a><span class="c">!!      integer           :: r</span>
<a name="ln-4671"></a><span class="c">!!</span>
<a name="ln-4672"></a><span class="c">!!      print *,&#39; BASE CONVERSION&#39;</span>
<a name="ln-4673"></a><span class="c">!!      write(*,&#39;(&quot;Start   Base (2 to 36): &quot;)&#39;,advance=&#39;no&#39;); read *, bd</span>
<a name="ln-4674"></a><span class="c">!!      write(*,&#39;(&quot;Arrival Base (2 to 36): &quot;)&#39;,advance=&#39;no&#39;); read *, ba</span>
<a name="ln-4675"></a><span class="c">!!      INFINITE: do</span>
<a name="ln-4676"></a><span class="c">!!         print *,&#39;&#39;</span>
<a name="ln-4677"></a><span class="c">!!         write(*,&#39;(&quot;Enter number in start base: &quot;)&#39;,advance=&#39;no&#39;); read *, x</span>
<a name="ln-4678"></a><span class="c">!!         if(x.eq.&#39;0&#39;) exit INFINITE</span>
<a name="ln-4679"></a><span class="c">!!         if(decodebase(x,bd,r)) then</span>
<a name="ln-4680"></a><span class="c">!!            if(codebase(r,ba,y)) then</span>
<a name="ln-4681"></a><span class="c">!!              write(*,&#39;(&quot;In base &quot;,I2,&quot;: &quot;,A20)&#39;)  ba, y</span>
<a name="ln-4682"></a><span class="c">!!            else</span>
<a name="ln-4683"></a><span class="c">!!              print *,&#39;Error in coding number.&#39;</span>
<a name="ln-4684"></a><span class="c">!!            endif</span>
<a name="ln-4685"></a><span class="c">!!         else</span>
<a name="ln-4686"></a><span class="c">!!            print *,&#39;Error in decoding number.&#39;</span>
<a name="ln-4687"></a><span class="c">!!         endif</span>
<a name="ln-4688"></a><span class="c">!!      enddo INFINITE</span>
<a name="ln-4689"></a><span class="c">!!</span>
<a name="ln-4690"></a><span class="c">!!      end program demo_decodebase</span>
<a name="ln-4691"></a><span class="c">!!</span>
<a name="ln-4692"></a><span class="c">!!##AUTHOR</span>
<a name="ln-4693"></a><span class="c">!!    John S. Urban</span>
<a name="ln-4694"></a><span class="c">!!</span>
<a name="ln-4695"></a><span class="c">!!       Ref.: &quot;Math matiques en Turbo-Pascal by</span>
<a name="ln-4696"></a><span class="c">!!              M. Ducamp and A. Reverchon (2),</span>
<a name="ln-4697"></a><span class="c">!!              Eyrolles, Paris, 1988&quot;.</span>
<a name="ln-4698"></a><span class="c">!!</span>
<a name="ln-4699"></a><span class="c">!!    based on a F90 Version By J-P Moreau (www.jpmoreau.fr)</span>
<a name="ln-4700"></a><span class="c">!!</span>
<a name="ln-4701"></a><span class="c">!!##LICENSE</span>
<a name="ln-4702"></a><span class="c">!!    Public Domain</span>
<a name="ln-4703"></a><span class="kt">logical </span><span class="k">function </span><span class="n">decodebase</span><span class="p">(</span><span class="n">string</span><span class="p">,</span><span class="n">basein</span><span class="p">,</span><span class="n">out_baseten</span><span class="p">)</span>
<a name="ln-4704"></a><span class="k">implicit none</span>
<a name="ln-4705"></a>
<a name="ln-4706"></a><span class="c">! ident_24=&quot;@(#)M_CLI2::decodebase(3f): convert whole number string in base [2-36] to base 10 number&quot;</span>
<a name="ln-4707"></a>
<a name="ln-4708"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>  <span class="kd">::</span> <span class="n">string</span>
<a name="ln-4709"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>           <span class="kd">::</span> <span class="n">basein</span>
<a name="ln-4710"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">out_baseten</span>
<a name="ln-4711"></a>
<a name="ln-4712"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">string</span><span class="p">))</span>   <span class="kd">::</span> <span class="n">string_local</span>
<a name="ln-4713"></a><span class="kt">integer</span>           <span class="kd">::</span> <span class="nb">long</span><span class="p">,</span> <span class="n">i</span><span class="p">,</span> <span class="n">j</span><span class="p">,</span> <span class="n">k</span>
<a name="ln-4714"></a><span class="kt">real</span>              <span class="kd">::</span> <span class="n">y</span>
<a name="ln-4715"></a><span class="kt">real</span>              <span class="kd">::</span> <span class="n">mult</span>
<a name="ln-4716"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">1</span><span class="p">)</span>  <span class="kd">::</span> <span class="n">ch</span>
<a name="ln-4717"></a><span class="kt">real</span><span class="p">,</span><span class="k">parameter</span>    <span class="kd">::</span> <span class="n">XMAXREAL</span><span class="o">=</span><span class="kt">real</span><span class="p">(</span><span class="nb">huge</span><span class="p">(</span><span class="mi">1</span><span class="p">))</span>
<a name="ln-4718"></a><span class="kt">integer</span>           <span class="kd">::</span> <span class="n">out_sign</span>
<a name="ln-4719"></a><span class="kt">integer</span>           <span class="kd">::</span> <span class="n">basein_local</span>
<a name="ln-4720"></a><span class="kt">integer</span>           <span class="kd">::</span> <span class="n">ipound</span>
<a name="ln-4721"></a><span class="kt">integer</span>           <span class="kd">::</span> <span class="n">ierr</span>
<a name="ln-4722"></a>
<a name="ln-4723"></a>  <span class="n">string_local</span><span class="o">=</span><span class="n">upper</span><span class="p">(</span><span class="nb">trim</span><span class="p">(</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">string</span><span class="p">)))</span>
<a name="ln-4724"></a>  <span class="n">decodebase</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>
<a name="ln-4725"></a>
<a name="ln-4726"></a>  <span class="n">ipound</span><span class="o">=</span><span class="nb">index</span><span class="p">(</span><span class="n">string_local</span><span class="p">,</span><span class="s1">&#39;#&#39;</span><span class="p">)</span>                                       <span class="c">! determine if in form [-]base#whole</span>
<a name="ln-4727"></a>  <span class="k">if</span><span class="p">(</span><span class="n">basein</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="mf">0.</span><span class="nb">and</span><span class="p">.</span><span class="n">ipound</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="mi">1</span><span class="p">)</span><span class="k">then</span>                                  <span class="c">! split string into two values</span>
<a name="ln-4728"></a>     <span class="k">call </span><span class="n">a2i</span><span class="p">(</span><span class="n">string_local</span><span class="p">(:</span><span class="n">ipound</span><span class="o">-</span><span class="mi">1</span><span class="p">),</span><span class="n">basein_local</span><span class="p">,</span><span class="n">ierr</span><span class="p">)</span>   <span class="c">! get the decimal value of the base</span>
<a name="ln-4729"></a>     <span class="n">string_local</span><span class="o">=</span><span class="n">string_local</span><span class="p">(</span><span class="n">ipound</span><span class="o">+</span><span class="mi">1</span><span class="p">:)</span>                              <span class="c">! now that base is known make string just the value</span>
<a name="ln-4730"></a>     <span class="k">if</span><span class="p">(</span><span class="n">basein_local</span><span class="p">.</span><span class="n">ge</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                         <span class="c">! allow for a negative sign prefix</span>
<a name="ln-4731"></a>        <span class="n">out_sign</span><span class="o">=</span><span class="mi">1</span>
<a name="ln-4732"></a>     <span class="k">else</span>
<a name="ln-4733"></a><span class="k">        </span><span class="n">out_sign</span><span class="o">=-</span><span class="mi">1</span>
<a name="ln-4734"></a>     <span class="k">endif</span>
<a name="ln-4735"></a><span class="k">     </span><span class="n">basein_local</span><span class="o">=</span><span class="nb">abs</span><span class="p">(</span><span class="n">basein_local</span><span class="p">)</span>
<a name="ln-4736"></a>  <span class="k">else</span>                                                                 <span class="c">! assume string is a simple positive value</span>
<a name="ln-4737"></a>     <span class="n">basein_local</span><span class="o">=</span><span class="nb">abs</span><span class="p">(</span><span class="n">basein</span><span class="p">)</span>
<a name="ln-4738"></a>     <span class="n">out_sign</span><span class="o">=</span><span class="mi">1</span>
<a name="ln-4739"></a>  <span class="k">endif</span>
<a name="ln-4740"></a>
<a name="ln-4741"></a><span class="k">  </span><span class="n">out_baseten</span><span class="o">=</span><span class="mi">0</span>
<a name="ln-4742"></a>  <span class="n">y</span><span class="o">=</span><span class="mf">0.0</span>
<a name="ln-4743"></a>  <span class="k">ALL</span><span class="p">:</span> <span class="k">if</span><span class="p">(</span><span class="n">basein_local</span><span class="o">&lt;</span><span class="mf">2.</span><span class="nb">or</span><span class="p">.</span><span class="n">basein_local</span><span class="o">&gt;</span><span class="mi">36</span><span class="p">)</span> <span class="k">then</span>
<a name="ln-4744"></a><span class="k">    print</span> <span class="o">*</span><span class="p">,</span><span class="s1">&#39;(*decodebase* ERROR: Base must be between 2 and 36. base=&#39;</span><span class="p">,</span><span class="n">basein_local</span>
<a name="ln-4745"></a>  <span class="k">else ALL</span>
<a name="ln-4746"></a><span class="k">     </span><span class="n">out_baseten</span><span class="o">=</span><span class="mi">0</span><span class="p">;</span><span class="n">y</span><span class="o">=</span><span class="mf">0.0</span><span class="p">;</span> <span class="n">mult</span><span class="o">=</span><span class="mf">1.0</span>
<a name="ln-4747"></a>     <span class="nb">long</span><span class="o">=</span><span class="nb">LEN_TRIM</span><span class="p">(</span><span class="n">string_local</span><span class="p">)</span>
<a name="ln-4748"></a>     <span class="k">do </span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span> <span class="nb">long</span>
<a name="ln-4749"></a><span class="nb">        </span><span class="n">k</span><span class="o">=</span><span class="nb">long</span><span class="o">+</span><span class="mi">1</span><span class="o">-</span><span class="n">i</span>
<a name="ln-4750"></a>        <span class="n">ch</span><span class="o">=</span><span class="n">string_local</span><span class="p">(</span><span class="n">k</span><span class="p">:</span><span class="n">k</span><span class="p">)</span>
<a name="ln-4751"></a>        <span class="k">if</span><span class="p">(</span><span class="n">ch</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="s1">&#39;-&#39;</span><span class="p">.</span><span class="nb">and</span><span class="p">.</span><span class="n">k</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="mi">1</span><span class="p">)</span><span class="k">then</span>
<a name="ln-4752"></a><span class="k">           </span><span class="n">out_sign</span><span class="o">=-</span><span class="mi">1</span>
<a name="ln-4753"></a>           <span class="k">cycle</span>
<a name="ln-4754"></a><span class="k">        endif</span>
<a name="ln-4755"></a><span class="k">        if</span><span class="p">(</span><span class="n">ch</span><span class="o">&lt;</span><span class="s1">&#39;0&#39;</span><span class="p">.</span><span class="nb">or</span><span class="p">.</span><span class="n">ch</span><span class="o">&gt;</span><span class="s1">&#39;Z&#39;</span><span class="p">.</span><span class="nb">or</span><span class="p">.(</span><span class="n">ch</span><span class="o">&gt;</span><span class="s1">&#39;9&#39;</span><span class="p">.</span><span class="nb">and</span><span class="p">.</span><span class="n">ch</span><span class="o">&lt;</span><span class="s1">&#39;A&#39;</span><span class="p">))</span><span class="k">then</span>
<a name="ln-4756"></a><span class="k">           write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="o">*</span><span class="p">)</span><span class="s1">&#39;*decodebase* ERROR: invalid character &#39;</span><span class="p">,</span><span class="n">ch</span>
<a name="ln-4757"></a>           <span class="k">exit ALL</span>
<a name="ln-4758"></a><span class="k">        endif</span>
<a name="ln-4759"></a><span class="k">        if</span><span class="p">(</span><span class="n">ch</span><span class="o">&lt;=</span><span class="s1">&#39;9&#39;</span><span class="p">)</span> <span class="k">then</span>
<a name="ln-4760"></a><span class="k">              </span><span class="n">j</span><span class="o">=</span><span class="nb">IACHAR</span><span class="p">(</span><span class="n">ch</span><span class="p">)</span><span class="o">-</span><span class="nb">IACHAR</span><span class="p">(</span><span class="s1">&#39;0&#39;</span><span class="p">)</span>
<a name="ln-4761"></a>        <span class="k">else</span>
<a name="ln-4762"></a><span class="k">              </span><span class="n">j</span><span class="o">=</span><span class="nb">IACHAR</span><span class="p">(</span><span class="n">ch</span><span class="p">)</span><span class="o">-</span><span class="nb">IACHAR</span><span class="p">(</span><span class="s1">&#39;A&#39;</span><span class="p">)</span><span class="o">+</span><span class="mi">10</span>
<a name="ln-4763"></a>        <span class="k">endif</span>
<a name="ln-4764"></a><span class="k">        if</span><span class="p">(</span><span class="n">j</span><span class="o">&gt;=</span><span class="n">basein_local</span><span class="p">)</span><span class="k">then</span>
<a name="ln-4765"></a><span class="k">           exit ALL</span>
<a name="ln-4766"></a><span class="k">        endif</span>
<a name="ln-4767"></a><span class="k">        </span><span class="n">y</span><span class="o">=</span><span class="n">y</span><span class="o">+</span><span class="n">mult</span><span class="o">*</span><span class="n">j</span>
<a name="ln-4768"></a>        <span class="k">if</span><span class="p">(</span><span class="n">mult</span><span class="o">&gt;</span><span class="n">XMAXREAL</span><span class="o">/</span><span class="n">basein_local</span><span class="p">)</span><span class="k">then</span>
<a name="ln-4769"></a><span class="k">           exit ALL</span>
<a name="ln-4770"></a><span class="k">        endif</span>
<a name="ln-4771"></a><span class="k">        </span><span class="n">mult</span><span class="o">=</span><span class="n">mult</span><span class="o">*</span><span class="n">basein_local</span>
<a name="ln-4772"></a>     <span class="k">enddo</span>
<a name="ln-4773"></a><span class="k">     </span><span class="n">decodebase</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.</span>
<a name="ln-4774"></a>     <span class="n">out_baseten</span><span class="o">=</span><span class="nb">nint</span><span class="p">(</span><span class="n">out_sign</span><span class="o">*</span><span class="n">y</span><span class="p">)</span><span class="o">*</span><span class="nb">sign</span><span class="p">(</span><span class="mi">1</span><span class="p">,</span><span class="n">basein</span><span class="p">)</span>
<a name="ln-4775"></a>  <span class="k">endif ALL</span>
<a name="ln-4776"></a><span class="k">end function </span><span class="n">decodebase</span>
<a name="ln-4777"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-4778"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-4779"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-4780"></a><span class="c">!&gt;</span>
<a name="ln-4781"></a><span class="c">!!##NAME</span>
<a name="ln-4782"></a><span class="c">!!    lenset(3f) - [M_CLI2:LENGTH] return string trimmed or padded to</span>
<a name="ln-4783"></a><span class="c">!!                 specified length</span>
<a name="ln-4784"></a><span class="c">!!    (LICENSE:PD)</span>
<a name="ln-4785"></a><span class="c">!!</span>
<a name="ln-4786"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-4787"></a><span class="c">!!</span>
<a name="ln-4788"></a><span class="c">!!    function lenset(str,length) result(strout)</span>
<a name="ln-4789"></a><span class="c">!!</span>
<a name="ln-4790"></a><span class="c">!!     character(len=*)                     :: str</span>
<a name="ln-4791"></a><span class="c">!!     character(len=length)                :: strout</span>
<a name="ln-4792"></a><span class="c">!!     integer,intent(in)                   :: length</span>
<a name="ln-4793"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-4794"></a><span class="c">!!    lenset(3f) truncates a string or pads it with spaces to the specified</span>
<a name="ln-4795"></a><span class="c">!!    length.</span>
<a name="ln-4796"></a><span class="c">!!##OPTIONS</span>
<a name="ln-4797"></a><span class="c">!!    str     input string</span>
<a name="ln-4798"></a><span class="c">!!    length  output string length</span>
<a name="ln-4799"></a><span class="c">!!##RESULTS</span>
<a name="ln-4800"></a><span class="c">!!    strout  output string</span>
<a name="ln-4801"></a><span class="c">!!##EXAMPLE</span>
<a name="ln-4802"></a><span class="c">!!</span>
<a name="ln-4803"></a><span class="c">!! Sample Program:</span>
<a name="ln-4804"></a><span class="c">!!</span>
<a name="ln-4805"></a><span class="c">!!     program demo_lenset</span>
<a name="ln-4806"></a><span class="c">!!      use M_CLI2, only : lenset</span>
<a name="ln-4807"></a><span class="c">!!      implicit none</span>
<a name="ln-4808"></a><span class="c">!!      character(len=10)            :: string=&#39;abcdefghij&#39;</span>
<a name="ln-4809"></a><span class="c">!!      character(len=:),allocatable :: answer</span>
<a name="ln-4810"></a><span class="c">!!         answer=lenset(string,5)</span>
<a name="ln-4811"></a><span class="c">!!         write(*,&#39;(&quot;[&quot;,a,&quot;]&quot;)&#39;) answer</span>
<a name="ln-4812"></a><span class="c">!!         answer=lenset(string,20)</span>
<a name="ln-4813"></a><span class="c">!!         write(*,&#39;(&quot;[&quot;,a,&quot;]&quot;)&#39;) answer</span>
<a name="ln-4814"></a><span class="c">!!     end program demo_lenset</span>
<a name="ln-4815"></a><span class="c">!!</span>
<a name="ln-4816"></a><span class="c">!!    Expected output:</span>
<a name="ln-4817"></a><span class="c">!!</span>
<a name="ln-4818"></a><span class="c">!!     [abcde]</span>
<a name="ln-4819"></a><span class="c">!!     [abcdefghij          ]</span>
<a name="ln-4820"></a><span class="c">!!</span>
<a name="ln-4821"></a><span class="c">!!##AUTHOR</span>
<a name="ln-4822"></a><span class="c">!!    John S. Urban</span>
<a name="ln-4823"></a><span class="c">!!##LICENSE</span>
<a name="ln-4824"></a><span class="c">!!    Public Domain</span>
<a name="ln-4825"></a><span class="k">function </span><span class="n">lenset</span><span class="p">(</span><span class="n">line</span><span class="p">,</span><span class="n">length</span><span class="p">)</span> <span class="k">result</span><span class="p">(</span><span class="n">strout</span><span class="p">)</span>
<a name="ln-4826"></a>
<a name="ln-4827"></a><span class="c">! ident_25=&quot;@(#)M_CLI2::lenset(3f): return string trimmed or padded to specified length&quot;</span>
<a name="ln-4828"></a>
<a name="ln-4829"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>  <span class="kd">::</span>  <span class="n">line</span>
<a name="ln-4830"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>           <span class="kd">::</span>  <span class="n">length</span>
<a name="ln-4831"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="n">length</span><span class="p">)</span>        <span class="kd">::</span>  <span class="n">strout</span>
<a name="ln-4832"></a>   <span class="n">strout</span><span class="o">=</span><span class="n">line</span>
<a name="ln-4833"></a><span class="k">end function </span><span class="n">lenset</span>
<a name="ln-4834"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-4835"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-4836"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-4837"></a><span class="c">!&gt;</span>
<a name="ln-4838"></a><span class="c">!!##NAME</span>
<a name="ln-4839"></a><span class="c">!!      value_to_string(3f) - [M_CLI2:NUMERIC] return numeric string from</span>
<a name="ln-4840"></a><span class="c">!!                            a numeric value</span>
<a name="ln-4841"></a><span class="c">!!      (LICENSE:PD)</span>
<a name="ln-4842"></a><span class="c">!!</span>
<a name="ln-4843"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-4844"></a><span class="c">!!</span>
<a name="ln-4845"></a><span class="c">!!    subroutine value_to_string(value,chars[,iilen,ierr,fmt,trimz])</span>
<a name="ln-4846"></a><span class="c">!!</span>
<a name="ln-4847"></a><span class="c">!!     character(len=*) :: chars  ! minimum of 23 characters required</span>
<a name="ln-4848"></a><span class="c">!!     !--------</span>
<a name="ln-4849"></a><span class="c">!!     ! VALUE may be any &lt;em&gt;one&lt;/em&gt; of the following types:</span>
<a name="ln-4850"></a><span class="c">!!     doubleprecision,intent(in)               :: value</span>
<a name="ln-4851"></a><span class="c">!!     real,intent(in)                          :: value</span>
<a name="ln-4852"></a><span class="c">!!     integer,intent(in)                       :: value</span>
<a name="ln-4853"></a><span class="c">!!     logical,intent(in)                       :: value</span>
<a name="ln-4854"></a><span class="c">!!     !--------</span>
<a name="ln-4855"></a><span class="c">!!     character(len=*),intent(out)             :: chars</span>
<a name="ln-4856"></a><span class="c">!!     integer,intent(out),optional             :: iilen</span>
<a name="ln-4857"></a><span class="c">!!     integer,optional                         :: ierr</span>
<a name="ln-4858"></a><span class="c">!!     character(len=*),intent(in),optional     :: fmt</span>
<a name="ln-4859"></a><span class="c">!!     logical,intent(in)                       :: trimz</span>
<a name="ln-4860"></a><span class="c">!!</span>
<a name="ln-4861"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-4862"></a><span class="c">!!    value_to_string(3f) returns a numeric representation of a numeric</span>
<a name="ln-4863"></a><span class="c">!!    value in a string given a numeric value of type REAL, DOUBLEPRECISION,</span>
<a name="ln-4864"></a><span class="c">!!    INTEGER or LOGICAL. It creates the string using internal writes. It</span>
<a name="ln-4865"></a><span class="c">!!    then removes trailing zeros from non-zero values, and left-justifies</span>
<a name="ln-4866"></a><span class="c">!!    the string.</span>
<a name="ln-4867"></a><span class="c">!!</span>
<a name="ln-4868"></a><span class="c">!!##OPTIONS</span>
<a name="ln-4869"></a><span class="c">!!       VALUE   input value to be converted to a string</span>
<a name="ln-4870"></a><span class="c">!!       FMT     You may specify a specific format that produces a string</span>
<a name="ln-4871"></a><span class="c">!!               up to the length of CHARS; optional.</span>
<a name="ln-4872"></a><span class="c">!!       TRIMZ   If a format is supplied the default is not to try to trim</span>
<a name="ln-4873"></a><span class="c">!!               trailing zeros. Set TRIMZ to .true. to trim zeros from a</span>
<a name="ln-4874"></a><span class="c">!!               string assumed to represent a simple numeric value.</span>
<a name="ln-4875"></a><span class="c">!!</span>
<a name="ln-4876"></a><span class="c">!!##RETURNS</span>
<a name="ln-4877"></a><span class="c">!!       CHARS   returned string representing input value, must be at least</span>
<a name="ln-4878"></a><span class="c">!!               23 characters long; or what is required by optional FMT</span>
<a name="ln-4879"></a><span class="c">!!               if longer.</span>
<a name="ln-4880"></a><span class="c">!!       IILEN   position of last non-blank character in returned string;</span>
<a name="ln-4881"></a><span class="c">!!               optional.</span>
<a name="ln-4882"></a><span class="c">!!       IERR    If not zero, error occurred; optional.</span>
<a name="ln-4883"></a><span class="c">!!##EXAMPLE</span>
<a name="ln-4884"></a><span class="c">!!</span>
<a name="ln-4885"></a><span class="c">!! Sample program:</span>
<a name="ln-4886"></a><span class="c">!!</span>
<a name="ln-4887"></a><span class="c">!!      program demo_value_to_string</span>
<a name="ln-4888"></a><span class="c">!!      use M_CLI2, only: value_to_string</span>
<a name="ln-4889"></a><span class="c">!!      implicit none</span>
<a name="ln-4890"></a><span class="c">!!      character(len=80) :: string</span>
<a name="ln-4891"></a><span class="c">!!      integer           :: iilen</span>
<a name="ln-4892"></a><span class="c">!!         call value_to_string(3.0/4.0,string,iilen)</span>
<a name="ln-4893"></a><span class="c">!!         write(*,*) &#39;The value is [&#39;,string(:iilen),&#39;]&#39;</span>
<a name="ln-4894"></a><span class="c">!!</span>
<a name="ln-4895"></a><span class="c">!!         call value_to_string(3.0/4.0,string,iilen,fmt=&#39;&#39;)</span>
<a name="ln-4896"></a><span class="c">!!         write(*,*) &#39;The value is [&#39;,string(:iilen),&#39;]&#39;</span>
<a name="ln-4897"></a><span class="c">!!</span>
<a name="ln-4898"></a><span class="c">!!         call value_to_string(3.0/4.0,string,iilen,fmt=&#39;(&quot;THE VALUE IS &quot;,g0)&#39;)</span>
<a name="ln-4899"></a><span class="c">!!         write(*,*) &#39;The value is [&#39;,string(:iilen),&#39;]&#39;</span>
<a name="ln-4900"></a><span class="c">!!</span>
<a name="ln-4901"></a><span class="c">!!         call value_to_string(1234,string,iilen)</span>
<a name="ln-4902"></a><span class="c">!!         write(*,*) &#39;The value is [&#39;,string(:iilen),&#39;]&#39;</span>
<a name="ln-4903"></a><span class="c">!!</span>
<a name="ln-4904"></a><span class="c">!!         call value_to_string(1.0d0/3.0d0,string,iilen)</span>
<a name="ln-4905"></a><span class="c">!!         write(*,*) &#39;The value is [&#39;,string(:iilen),&#39;]&#39;</span>
<a name="ln-4906"></a><span class="c">!!</span>
<a name="ln-4907"></a><span class="c">!!      end program demo_value_to_string</span>
<a name="ln-4908"></a><span class="c">!!</span>
<a name="ln-4909"></a><span class="c">!!    Expected output</span>
<a name="ln-4910"></a><span class="c">!!</span>
<a name="ln-4911"></a><span class="c">!!     The value is [0.75]</span>
<a name="ln-4912"></a><span class="c">!!     The value is [      0.7500000000]</span>
<a name="ln-4913"></a><span class="c">!!     The value is [THE VALUE IS .750000000]</span>
<a name="ln-4914"></a><span class="c">!!     The value is [1234]</span>
<a name="ln-4915"></a><span class="c">!!     The value is [0.33333333333333331]</span>
<a name="ln-4916"></a><span class="c">!!</span>
<a name="ln-4917"></a><span class="c">!!##AUTHOR</span>
<a name="ln-4918"></a><span class="c">!!    John S. Urban</span>
<a name="ln-4919"></a><span class="c">!!##LICENSE</span>
<a name="ln-4920"></a><span class="c">!!    Public Domain</span>
<a name="ln-4921"></a><span class="k">subroutine </span><span class="n">value_to_string</span><span class="p">(</span><span class="n">gval</span><span class="p">,</span><span class="n">chars</span><span class="p">,</span><span class="n">length</span><span class="p">,</span><span class="n">err</span><span class="p">,</span><span class="n">fmt</span><span class="p">,</span><span class="n">trimz</span><span class="p">)</span>
<a name="ln-4922"></a>
<a name="ln-4923"></a><span class="c">! ident_26=&quot;@(#)M_CLI2::value_to_string(3fp): subroutine returns a string from a value&quot;</span>
<a name="ln-4924"></a>
<a name="ln-4925"></a><span class="k">class</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>                      <span class="kd">::</span> <span class="n">gval</span>
<a name="ln-4926"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span>             <span class="kd">::</span> <span class="n">chars</span>
<a name="ln-4927"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">),</span><span class="k">optional</span>             <span class="kd">::</span> <span class="n">length</span>
<a name="ln-4928"></a><span class="kt">integer</span><span class="p">,</span><span class="k">optional</span>                         <span class="kd">::</span> <span class="n">err</span>
<a name="ln-4929"></a><span class="kt">integer</span>                                  <span class="kd">::</span> <span class="n">err_local</span>
<a name="ln-4930"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">optional</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>     <span class="kd">::</span> <span class="n">fmt</span>         <span class="c">! format to write value with</span>
<a name="ln-4931"></a><span class="kt">logical</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>              <span class="kd">::</span> <span class="n">trimz</span>
<a name="ln-4932"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>             <span class="kd">::</span> <span class="n">fmt_local</span>
<a name="ln-4933"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">1024</span><span class="p">)</span>                      <span class="kd">::</span> <span class="n">msg</span>
<a name="ln-4934"></a>
<a name="ln-4935"></a><span class="c">!  Notice that the value GVAL can be any of several types ( INTEGER,REAL,DOUBLEPRECISION,LOGICAL)</span>
<a name="ln-4936"></a>
<a name="ln-4937"></a>   <span class="k">if</span> <span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">fmt</span><span class="p">))</span> <span class="k">then</span>
<a name="ln-4938"></a><span class="k">      select type</span><span class="p">(</span><span class="n">gval</span><span class="p">)</span>
<a name="ln-4939"></a>      <span class="k">type is</span> <span class="p">(</span><span class="kt">integer</span><span class="p">)</span>
<a name="ln-4940"></a>         <span class="n">fmt_local</span><span class="o">=</span><span class="s1">&#39;(i0)&#39;</span>
<a name="ln-4941"></a>         <span class="k">if</span><span class="p">(</span><span class="n">fmt</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39;&#39;</span><span class="p">)</span> <span class="n">fmt_local</span><span class="o">=</span><span class="n">fmt</span>
<a name="ln-4942"></a>         <span class="k">write</span><span class="p">(</span><span class="n">chars</span><span class="p">,</span><span class="n">fmt_local</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">err_local</span><span class="p">,</span><span class="n">iomsg</span><span class="o">=</span><span class="n">msg</span><span class="p">)</span><span class="n">gval</span>
<a name="ln-4943"></a>      <span class="k">type is</span> <span class="p">(</span><span class="kt">real</span><span class="p">)</span>
<a name="ln-4944"></a>         <span class="n">fmt_local</span><span class="o">=</span><span class="s1">&#39;(bz,g23.10e3)&#39;</span>
<a name="ln-4945"></a>         <span class="n">fmt_local</span><span class="o">=</span><span class="s1">&#39;(bz,g0.8)&#39;</span>
<a name="ln-4946"></a>         <span class="k">if</span><span class="p">(</span><span class="n">fmt</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39;&#39;</span><span class="p">)</span> <span class="n">fmt_local</span><span class="o">=</span><span class="n">fmt</span>
<a name="ln-4947"></a>         <span class="k">write</span><span class="p">(</span><span class="n">chars</span><span class="p">,</span><span class="n">fmt_local</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">err_local</span><span class="p">,</span><span class="n">iomsg</span><span class="o">=</span><span class="n">msg</span><span class="p">)</span><span class="n">gval</span>
<a name="ln-4948"></a>      <span class="k">type is</span> <span class="p">(</span><span class="n">doubleprecision</span><span class="p">)</span>
<a name="ln-4949"></a>         <span class="n">fmt_local</span><span class="o">=</span><span class="s1">&#39;(bz,g0)&#39;</span>
<a name="ln-4950"></a>         <span class="k">if</span><span class="p">(</span><span class="n">fmt</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39;&#39;</span><span class="p">)</span> <span class="n">fmt_local</span><span class="o">=</span><span class="n">fmt</span>
<a name="ln-4951"></a>         <span class="k">write</span><span class="p">(</span><span class="n">chars</span><span class="p">,</span><span class="n">fmt_local</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">err_local</span><span class="p">,</span><span class="n">iomsg</span><span class="o">=</span><span class="n">msg</span><span class="p">)</span><span class="n">gval</span>
<a name="ln-4952"></a>      <span class="k">type is</span> <span class="p">(</span><span class="kt">logical</span><span class="p">)</span>
<a name="ln-4953"></a>         <span class="n">fmt_local</span><span class="o">=</span><span class="s1">&#39;(l1)&#39;</span>
<a name="ln-4954"></a>         <span class="k">if</span><span class="p">(</span><span class="n">fmt</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="s1">&#39;&#39;</span><span class="p">)</span> <span class="n">fmt_local</span><span class="o">=</span><span class="n">fmt</span>
<a name="ln-4955"></a>         <span class="k">write</span><span class="p">(</span><span class="n">chars</span><span class="p">,</span><span class="n">fmt_local</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">err_local</span><span class="p">,</span><span class="n">iomsg</span><span class="o">=</span><span class="n">msg</span><span class="p">)</span><span class="n">gval</span>
<a name="ln-4956"></a>      <span class="k">class </span><span class="n">default</span>
<a name="ln-4957"></a>         <span class="k">call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*value_to_string* UNKNOWN TYPE&#39;</span><span class="p">)</span>
<a name="ln-4958"></a>         <span class="n">chars</span><span class="o">=</span><span class="s1">&#39; &#39;</span>
<a name="ln-4959"></a>      <span class="k">end select</span>
<a name="ln-4960"></a><span class="k">      if</span><span class="p">(</span><span class="n">fmt</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="s1">&#39;&#39;</span><span class="p">)</span> <span class="k">then</span>
<a name="ln-4961"></a><span class="k">         </span><span class="n">chars</span><span class="o">=</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">chars</span><span class="p">)</span>
<a name="ln-4962"></a>         <span class="k">call </span><span class="n">trimzeros_</span><span class="p">(</span><span class="n">chars</span><span class="p">)</span>
<a name="ln-4963"></a>      <span class="k">endif</span>
<a name="ln-4964"></a><span class="k">   else</span>                                                  <span class="c">! no explicit format option present</span>
<a name="ln-4965"></a>      <span class="n">err_local</span><span class="o">=-</span><span class="mi">1</span>
<a name="ln-4966"></a>      <span class="k">select type</span><span class="p">(</span><span class="n">gval</span><span class="p">)</span>
<a name="ln-4967"></a>      <span class="k">type is</span> <span class="p">(</span><span class="kt">integer</span><span class="p">)</span>
<a name="ln-4968"></a>         <span class="k">write</span><span class="p">(</span><span class="n">chars</span><span class="p">,</span><span class="o">*</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">err_local</span><span class="p">,</span><span class="n">iomsg</span><span class="o">=</span><span class="n">msg</span><span class="p">)</span><span class="n">gval</span>
<a name="ln-4969"></a>      <span class="k">type is</span> <span class="p">(</span><span class="kt">real</span><span class="p">)</span>
<a name="ln-4970"></a>         <span class="k">write</span><span class="p">(</span><span class="n">chars</span><span class="p">,</span><span class="o">*</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">err_local</span><span class="p">,</span><span class="n">iomsg</span><span class="o">=</span><span class="n">msg</span><span class="p">)</span><span class="n">gval</span>
<a name="ln-4971"></a>      <span class="k">type is</span> <span class="p">(</span><span class="n">doubleprecision</span><span class="p">)</span>
<a name="ln-4972"></a>         <span class="k">write</span><span class="p">(</span><span class="n">chars</span><span class="p">,</span><span class="o">*</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">err_local</span><span class="p">,</span><span class="n">iomsg</span><span class="o">=</span><span class="n">msg</span><span class="p">)</span><span class="n">gval</span>
<a name="ln-4973"></a>      <span class="k">type is</span> <span class="p">(</span><span class="kt">logical</span><span class="p">)</span>
<a name="ln-4974"></a>         <span class="k">write</span><span class="p">(</span><span class="n">chars</span><span class="p">,</span><span class="o">*</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">err_local</span><span class="p">,</span><span class="n">iomsg</span><span class="o">=</span><span class="n">msg</span><span class="p">)</span><span class="n">gval</span>
<a name="ln-4975"></a>      <span class="k">class </span><span class="n">default</span>
<a name="ln-4976"></a>         <span class="n">chars</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-4977"></a>      <span class="k">end select</span>
<a name="ln-4978"></a><span class="k">      </span><span class="n">chars</span><span class="o">=</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">chars</span><span class="p">)</span>
<a name="ln-4979"></a>      <span class="k">if</span><span class="p">(</span><span class="nb">index</span><span class="p">(</span><span class="n">chars</span><span class="p">,</span><span class="s1">&#39;.&#39;</span><span class="p">).</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span> <span class="k">call </span><span class="n">trimzeros_</span><span class="p">(</span><span class="n">chars</span><span class="p">)</span>
<a name="ln-4980"></a>   <span class="k">endif</span>
<a name="ln-4981"></a><span class="k">   if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">trimz</span><span class="p">))</span><span class="k">then</span>
<a name="ln-4982"></a><span class="k">      if</span><span class="p">(</span><span class="n">trimz</span><span class="p">)</span><span class="k">then</span>
<a name="ln-4983"></a><span class="k">         </span><span class="n">chars</span><span class="o">=</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">chars</span><span class="p">)</span>
<a name="ln-4984"></a>         <span class="k">call </span><span class="n">trimzeros_</span><span class="p">(</span><span class="n">chars</span><span class="p">)</span>
<a name="ln-4985"></a>      <span class="k">endif</span>
<a name="ln-4986"></a><span class="k">   endif</span>
<a name="ln-4987"></a>
<a name="ln-4988"></a><span class="k">   if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">length</span><span class="p">))</span> <span class="k">then</span>
<a name="ln-4989"></a><span class="k">      </span><span class="n">length</span><span class="o">=</span><span class="nb">len_trim</span><span class="p">(</span><span class="n">chars</span><span class="p">)</span>
<a name="ln-4990"></a>   <span class="k">endif</span>
<a name="ln-4991"></a>
<a name="ln-4992"></a><span class="k">   if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">err</span><span class="p">))</span> <span class="k">then</span>
<a name="ln-4993"></a><span class="k">      </span><span class="n">err</span><span class="o">=</span><span class="n">err_local</span>
<a name="ln-4994"></a>   <span class="n">elseif</span><span class="p">(</span><span class="n">err_local</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-4995"></a>      <span class="c">!-! cannot currently do I/O from a function being called from I/O</span>
<a name="ln-4996"></a>      <span class="c">!-!write(ERROR_UNIT,&#39;(a)&#39;)&#39;*value_to_string* WARNING:[&#39;//trim(msg)//&#39;]&#39;</span>
<a name="ln-4997"></a>      <span class="n">chars</span><span class="o">=</span><span class="n">chars</span><span class="o">//</span><span class="s1">&#39; *value_to_string* WARNING:[&#39;</span><span class="o">//</span><span class="nb">trim</span><span class="p">(</span><span class="n">msg</span><span class="p">)</span><span class="o">//</span><span class="s1">&#39;]&#39;</span>
<a name="ln-4998"></a>   <span class="k">endif</span>
<a name="ln-4999"></a>
<a name="ln-5000"></a><span class="k">end subroutine </span><span class="n">value_to_string</span>
<a name="ln-5001"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-5002"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-5003"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-5004"></a><span class="c">!&gt;</span>
<a name="ln-5005"></a><span class="c">!!##NAME</span>
<a name="ln-5006"></a><span class="c">!!    trimzeros_(3fp) - [M_CLI2:NUMERIC] Delete trailing zeros from numeric</span>
<a name="ln-5007"></a><span class="c">!!                      `decimal string</span>
<a name="ln-5008"></a><span class="c">!!    (LICENSE:PD)</span>
<a name="ln-5009"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-5010"></a><span class="c">!!</span>
<a name="ln-5011"></a><span class="c">!!    subroutine trimzeros_(str)</span>
<a name="ln-5012"></a><span class="c">!!</span>
<a name="ln-5013"></a><span class="c">!!     character(len=*)  :: str</span>
<a name="ln-5014"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-5015"></a><span class="c">!!    TRIMZEROS_(3f) deletes trailing zeros from a string representing a</span>
<a name="ln-5016"></a><span class="c">!!    number. If the resulting string would end in a decimal point, one</span>
<a name="ln-5017"></a><span class="c">!!    trailing zero is added.</span>
<a name="ln-5018"></a><span class="c">!!##OPTIONS</span>
<a name="ln-5019"></a><span class="c">!!    str   input string will be assumed to be a numeric value and have</span>
<a name="ln-5020"></a><span class="c">!!          trailing zeros removed</span>
<a name="ln-5021"></a><span class="c">!!##EXAMPLES</span>
<a name="ln-5022"></a><span class="c">!!</span>
<a name="ln-5023"></a><span class="c">!! Sample program:</span>
<a name="ln-5024"></a><span class="c">!!</span>
<a name="ln-5025"></a><span class="c">!!       program demo_trimzeros_</span>
<a name="ln-5026"></a><span class="c">!!       use M_CLI2, only : trimzeros_</span>
<a name="ln-5027"></a><span class="c">!!       character(len=:),allocatable :: string</span>
<a name="ln-5028"></a><span class="c">!!          write(*,*)trimzeros_(&#39;123.450000000000&#39;)</span>
<a name="ln-5029"></a><span class="c">!!          write(*,*)trimzeros_(&#39;12345&#39;)</span>
<a name="ln-5030"></a><span class="c">!!          write(*,*)trimzeros_(&#39;12345.&#39;)</span>
<a name="ln-5031"></a><span class="c">!!          write(*,*)trimzeros_(&#39;12345.00e3&#39;)</span>
<a name="ln-5032"></a><span class="c">!!       end program demo_trimzeros_</span>
<a name="ln-5033"></a><span class="c">!!</span>
<a name="ln-5034"></a><span class="c">!!##AUTHOR</span>
<a name="ln-5035"></a><span class="c">!!    John S. Urban</span>
<a name="ln-5036"></a><span class="c">!!##LICENSE</span>
<a name="ln-5037"></a><span class="c">!!    Public Domain</span>
<a name="ln-5038"></a><span class="k">subroutine </span><span class="n">trimzeros_</span><span class="p">(</span><span class="n">string</span><span class="p">)</span>
<a name="ln-5039"></a>
<a name="ln-5040"></a><span class="c">! ident_27=&quot;@(#)M_CLI2::trimzeros_(3fp): Delete trailing zeros from numeric decimal string&quot;</span>
<a name="ln-5041"></a>
<a name="ln-5042"></a><span class="c">! if zero needs added at end assumes input string has room</span>
<a name="ln-5043"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">)</span>             <span class="kd">::</span> <span class="n">string</span>
<a name="ln-5044"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">string</span><span class="p">)</span><span class="o">+</span><span class="mi">2</span><span class="p">)</span> <span class="kd">::</span> <span class="n">str</span>
<a name="ln-5045"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">string</span><span class="p">))</span>   <span class="kd">::</span> <span class="n">expo</span>         <span class="c">! the exponent string if present</span>
<a name="ln-5046"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">ipos</span>         <span class="c">! where exponent letter appears if present</span>
<a name="ln-5047"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">i</span><span class="p">,</span> <span class="n">ii</span>
<a name="ln-5048"></a>   <span class="n">str</span><span class="o">=</span><span class="n">string</span>                                <span class="c">! working copy of string</span>
<a name="ln-5049"></a>   <span class="n">ipos</span><span class="o">=</span><span class="nb">scan</span><span class="p">(</span><span class="n">str</span><span class="p">,</span><span class="s1">&#39;eEdD&#39;</span><span class="p">)</span>                     <span class="c">! find end of real number if string uses exponent notation</span>
<a name="ln-5050"></a>   <span class="k">if</span><span class="p">(</span><span class="n">ipos</span><span class="o">&gt;</span><span class="mi">0</span><span class="p">)</span> <span class="k">then</span>                           <span class="c">! letter was found</span>
<a name="ln-5051"></a>      <span class="n">expo</span><span class="o">=</span><span class="n">str</span><span class="p">(</span><span class="n">ipos</span><span class="p">:)</span>                        <span class="c">! keep exponent string so it can be added back as a suffix</span>
<a name="ln-5052"></a>      <span class="n">str</span><span class="o">=</span><span class="n">str</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">ipos</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span>                      <span class="c">! just the real part, exponent removed will not have trailing zeros removed</span>
<a name="ln-5053"></a>   <span class="k">endif</span>
<a name="ln-5054"></a><span class="k">   if</span><span class="p">(</span><span class="nb">index</span><span class="p">(</span><span class="n">str</span><span class="p">,</span><span class="s1">&#39;.&#39;</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>               <span class="c">! if no decimal character in original string add one to end of string</span>
<a name="ln-5055"></a>      <span class="n">ii</span><span class="o">=</span><span class="nb">len_trim</span><span class="p">(</span><span class="n">str</span><span class="p">)</span>
<a name="ln-5056"></a>      <span class="n">str</span><span class="p">(</span><span class="n">ii</span><span class="o">+</span><span class="mi">1</span><span class="p">:</span><span class="n">ii</span><span class="o">+</span><span class="mi">1</span><span class="p">)</span><span class="o">=</span><span class="s1">&#39;.&#39;</span>                     <span class="c">! add decimal to end of string</span>
<a name="ln-5057"></a>   <span class="k">endif</span>
<a name="ln-5058"></a><span class="k">   do </span><span class="n">i</span><span class="o">=</span><span class="nb">len_trim</span><span class="p">(</span><span class="n">str</span><span class="p">),</span><span class="mi">1</span><span class="p">,</span><span class="o">-</span><span class="mi">1</span>                   <span class="c">! scanning from end find a non-zero character</span>
<a name="ln-5059"></a>      <span class="k">select case</span><span class="p">(</span><span class="n">str</span><span class="p">(</span><span class="n">i</span><span class="p">:</span><span class="n">i</span><span class="p">))</span>
<a name="ln-5060"></a>      <span class="k">case</span><span class="p">(</span><span class="s1">&#39;0&#39;</span><span class="p">)</span>                              <span class="c">! found a trailing zero so keep trimming</span>
<a name="ln-5061"></a>         <span class="k">cycle</span>
<a name="ln-5062"></a><span class="k">      case</span><span class="p">(</span><span class="s1">&#39;.&#39;</span><span class="p">)</span>                              <span class="c">! found a decimal character at end of remaining string</span>
<a name="ln-5063"></a>         <span class="k">if</span><span class="p">(</span><span class="n">i</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="mi">1</span><span class="p">)</span><span class="k">then</span>
<a name="ln-5064"></a><span class="k">            </span><span class="n">str</span><span class="o">=</span><span class="s1">&#39;0&#39;</span>
<a name="ln-5065"></a>         <span class="k">else</span>
<a name="ln-5066"></a><span class="k">            </span><span class="n">str</span><span class="o">=</span><span class="n">str</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">i</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span>
<a name="ln-5067"></a>         <span class="k">endif</span>
<a name="ln-5068"></a><span class="k">         exit</span>
<a name="ln-5069"></a><span class="k">      case </span><span class="n">default</span>
<a name="ln-5070"></a>         <span class="n">str</span><span class="o">=</span><span class="n">str</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">i</span><span class="p">)</span>                        <span class="c">! found a non-zero character so trim string and exit</span>
<a name="ln-5071"></a>         <span class="k">exit</span>
<a name="ln-5072"></a><span class="k">      end select</span>
<a name="ln-5073"></a><span class="k">   end do</span>
<a name="ln-5074"></a><span class="k">   if</span><span class="p">(</span><span class="n">ipos</span><span class="o">&gt;</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>                            <span class="c">! if originally had an exponent place it back on</span>
<a name="ln-5075"></a>      <span class="n">string</span><span class="o">=</span><span class="nb">trim</span><span class="p">(</span><span class="n">str</span><span class="p">)</span><span class="o">//</span><span class="nb">trim</span><span class="p">(</span><span class="n">expo</span><span class="p">)</span>
<a name="ln-5076"></a>   <span class="k">else</span>
<a name="ln-5077"></a><span class="k">      </span><span class="n">string</span><span class="o">=</span><span class="n">str</span>
<a name="ln-5078"></a>   <span class="k">endif</span>
<a name="ln-5079"></a><span class="k">end subroutine </span><span class="n">trimzeros_</span>
<a name="ln-5080"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-5081"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-5082"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-5083"></a><span class="c">!&gt;</span>
<a name="ln-5084"></a><span class="c">!!##NAME</span>
<a name="ln-5085"></a><span class="c">!!    substitute(3f) - [M_CLI2:EDITING] subroutine globally substitutes</span>
<a name="ln-5086"></a><span class="c">!!                     one substring for another in string</span>
<a name="ln-5087"></a><span class="c">!!    (LICENSE:PD)</span>
<a name="ln-5088"></a><span class="c">!!</span>
<a name="ln-5089"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-5090"></a><span class="c">!!</span>
<a name="ln-5091"></a><span class="c">!!    subroutine substitute(targetline,old,new,ierr,start,end)</span>
<a name="ln-5092"></a><span class="c">!!</span>
<a name="ln-5093"></a><span class="c">!!     character(len=*)              :: targetline</span>
<a name="ln-5094"></a><span class="c">!!     character(len=*),intent(in)   :: old</span>
<a name="ln-5095"></a><span class="c">!!     character(len=*),intent(in)   :: new</span>
<a name="ln-5096"></a><span class="c">!!     integer,intent(out),optional  :: ierr</span>
<a name="ln-5097"></a><span class="c">!!     integer,intent(in),optional   :: start</span>
<a name="ln-5098"></a><span class="c">!!     integer,intent(in),optional   :: end</span>
<a name="ln-5099"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-5100"></a><span class="c">!!    Globally substitute one substring for another in string.</span>
<a name="ln-5101"></a><span class="c">!!</span>
<a name="ln-5102"></a><span class="c">!!##OPTIONS</span>
<a name="ln-5103"></a><span class="c">!!     TARGETLINE  input line to be changed. Must be long enough to</span>
<a name="ln-5104"></a><span class="c">!!                 hold altered output.</span>
<a name="ln-5105"></a><span class="c">!!     OLD         substring to find and replace</span>
<a name="ln-5106"></a><span class="c">!!     NEW         replacement for OLD substring</span>
<a name="ln-5107"></a><span class="c">!!     IERR        error code. If IER = -1 bad directive, &gt;= 0 then</span>
<a name="ln-5108"></a><span class="c">!!                 count of changes made.</span>
<a name="ln-5109"></a><span class="c">!!     START       sets the left margin to be scanned for OLD in</span>
<a name="ln-5110"></a><span class="c">!!                 TARGETLINE.</span>
<a name="ln-5111"></a><span class="c">!!     END         sets the right margin to be scanned for OLD in</span>
<a name="ln-5112"></a><span class="c">!!                 TARGETLINE.</span>
<a name="ln-5113"></a><span class="c">!!</span>
<a name="ln-5114"></a><span class="c">!!##EXAMPLES</span>
<a name="ln-5115"></a><span class="c">!!</span>
<a name="ln-5116"></a><span class="c">!! Sample Program:</span>
<a name="ln-5117"></a><span class="c">!!</span>
<a name="ln-5118"></a><span class="c">!!     program demo_substitute</span>
<a name="ln-5119"></a><span class="c">!!     use M_CLI2, only : substitute</span>
<a name="ln-5120"></a><span class="c">!!     implicit none</span>
<a name="ln-5121"></a><span class="c">!!     ! must be long enough to hold changed line</span>
<a name="ln-5122"></a><span class="c">!!     character(len=80) :: targetline</span>
<a name="ln-5123"></a><span class="c">!!</span>
<a name="ln-5124"></a><span class="c">!!     targetline=&#39;this is the input string&#39;</span>
<a name="ln-5125"></a><span class="c">!!     write(*,*)&#39;ORIGINAL    : &#39;//trim(targetline)</span>
<a name="ln-5126"></a><span class="c">!!</span>
<a name="ln-5127"></a><span class="c">!!     ! changes the input to &#39;THis is THe input string&#39;</span>
<a name="ln-5128"></a><span class="c">!!     call substitute(targetline,&#39;th&#39;,&#39;TH&#39;)</span>
<a name="ln-5129"></a><span class="c">!!     write(*,*)&#39;th =&gt; TH    : &#39;//trim(targetline)</span>
<a name="ln-5130"></a><span class="c">!!</span>
<a name="ln-5131"></a><span class="c">!!     ! a null old substring means &quot;at beginning of line&quot;</span>
<a name="ln-5132"></a><span class="c">!!     ! changes the input to &#39;BEFORE:this is the input string&#39;</span>
<a name="ln-5133"></a><span class="c">!!     call substitute(targetline,&#39;&#39;,&#39;BEFORE:&#39;)</span>
<a name="ln-5134"></a><span class="c">!!     write(*,*)&#39;&quot;&quot; =&gt; BEFORE: &#39;//trim(targetline)</span>
<a name="ln-5135"></a><span class="c">!!</span>
<a name="ln-5136"></a><span class="c">!!     ! a null new string deletes occurrences of the old substring</span>
<a name="ln-5137"></a><span class="c">!!     ! changes the input to &#39;ths s the nput strng&#39;</span>
<a name="ln-5138"></a><span class="c">!!     call substitute(targetline,&#39;i&#39;,&#39;&#39;)</span>
<a name="ln-5139"></a><span class="c">!!     write(*,*)&#39;i =&gt; &quot;&quot;     : &#39;//trim(targetline)</span>
<a name="ln-5140"></a><span class="c">!!</span>
<a name="ln-5141"></a><span class="c">!!     end program demo_substitute</span>
<a name="ln-5142"></a><span class="c">!!</span>
<a name="ln-5143"></a><span class="c">!!   Expected output</span>
<a name="ln-5144"></a><span class="c">!!</span>
<a name="ln-5145"></a><span class="c">!!     ORIGINAL    : this is the input string</span>
<a name="ln-5146"></a><span class="c">!!     th =&gt; TH    : THis is THe input string</span>
<a name="ln-5147"></a><span class="c">!!     &quot;&quot; =&gt; BEFORE: BEFORE:THis is THe input string</span>
<a name="ln-5148"></a><span class="c">!!     i =&gt; &quot;&quot;     : BEFORE:THs s THe nput strng</span>
<a name="ln-5149"></a><span class="c">!!##AUTHOR</span>
<a name="ln-5150"></a><span class="c">!!    John S. Urban</span>
<a name="ln-5151"></a><span class="c">!!##LICENSE</span>
<a name="ln-5152"></a><span class="c">!!    Public Domain</span>
<a name="ln-5153"></a><span class="k">subroutine </span><span class="n">substitute</span><span class="p">(</span><span class="n">targetline</span><span class="p">,</span><span class="n">old</span><span class="p">,</span><span class="n">new</span><span class="p">,</span><span class="n">ierr</span><span class="p">,</span><span class="n">start</span><span class="p">,</span><span class="k">end</span><span class="p">)</span>
<a name="ln-5154"></a>
<a name="ln-5155"></a><span class="c">! ident_28=&quot;@(#)M_CLI2::substitute(3f): Globally substitute one substring for another in string&quot;</span>
<a name="ln-5156"></a>
<a name="ln-5157"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-5158"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">)</span>               <span class="kd">::</span> <span class="n">targetline</span>         <span class="c">! input line to be changed</span>
<a name="ln-5159"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>    <span class="kd">::</span> <span class="n">old</span>                <span class="c">! old substring to replace</span>
<a name="ln-5160"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>    <span class="kd">::</span> <span class="n">new</span>                <span class="c">! new substring</span>
<a name="ln-5161"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">),</span><span class="k">optional</span>   <span class="kd">::</span> <span class="n">ierr</span>               <span class="c">! error code. if ierr = -1 bad directive, &gt;=0 then ierr changes made</span>
<a name="ln-5162"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>    <span class="kd">::</span> <span class="n">start</span>              <span class="c">! start sets the left margin</span>
<a name="ln-5163"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>    <span class="kd">::</span> <span class="k">end</span>                <span class="c">! end sets the right margin</span>
<a name="ln-5164"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-5165"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">targetline</span><span class="p">))</span> <span class="kd">::</span> <span class="n">dum1</span>               <span class="c">! scratch string buffers</span>
<a name="ln-5166"></a><span class="kt">integer</span>                        <span class="kd">::</span> <span class="n">ml</span><span class="p">,</span> <span class="n">mr</span><span class="p">,</span> <span class="n">ier1</span>
<a name="ln-5167"></a><span class="kt">integer</span>                        <span class="kd">::</span> <span class="n">maxlengthout</span>       <span class="c">! MAXIMUM LENGTH ALLOWED FOR NEW STRING</span>
<a name="ln-5168"></a><span class="kt">integer</span>                        <span class="kd">::</span> <span class="n">original_input_length</span>
<a name="ln-5169"></a><span class="kt">integer</span>                        <span class="kd">::</span> <span class="n">len_old</span><span class="p">,</span> <span class="n">len_new</span>
<a name="ln-5170"></a><span class="kt">integer</span>                        <span class="kd">::</span> <span class="n">ladd</span>
<a name="ln-5171"></a><span class="kt">integer</span>                        <span class="kd">::</span> <span class="n">ir</span>
<a name="ln-5172"></a><span class="kt">integer</span>                        <span class="kd">::</span> <span class="n">ind</span>
<a name="ln-5173"></a><span class="kt">integer</span>                        <span class="kd">::</span> <span class="n">il</span>
<a name="ln-5174"></a><span class="kt">integer</span>                        <span class="kd">::</span> <span class="n">id</span>
<a name="ln-5175"></a><span class="kt">integer</span>                        <span class="kd">::</span> <span class="n">ic</span>
<a name="ln-5176"></a><span class="kt">integer</span>                        <span class="kd">::</span> <span class="n">iichar</span>
<a name="ln-5177"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-5178"></a>   <span class="k">if</span> <span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">start</span><span class="p">))</span> <span class="k">then</span>                            <span class="c">! optional starting column</span>
<a name="ln-5179"></a>      <span class="n">ml</span><span class="o">=</span><span class="n">start</span>
<a name="ln-5180"></a>   <span class="k">else</span>
<a name="ln-5181"></a><span class="k">      </span><span class="n">ml</span><span class="o">=</span><span class="mi">1</span>
<a name="ln-5182"></a>   <span class="k">endif</span>
<a name="ln-5183"></a><span class="k">   if</span> <span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="k">end</span><span class="p">))</span> <span class="k">then</span>                              <span class="c">! optional ending column</span>
<a name="ln-5184"></a>      <span class="n">mr</span><span class="o">=</span><span class="k">end</span>
<a name="ln-5185"></a><span class="k">   else</span>
<a name="ln-5186"></a><span class="k">      </span><span class="n">mr</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">targetline</span><span class="p">)</span>
<a name="ln-5187"></a>   <span class="k">endif</span>
<a name="ln-5188"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-5189"></a>   <span class="n">ier1</span><span class="o">=</span><span class="mi">0</span>                                              <span class="c">! initialize error flag/change count</span>
<a name="ln-5190"></a>   <span class="n">maxlengthout</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">targetline</span><span class="p">)</span>                        <span class="c">! max length of output string</span>
<a name="ln-5191"></a>   <span class="n">original_input_length</span><span class="o">=</span><span class="nb">len_trim</span><span class="p">(</span><span class="n">targetline</span><span class="p">)</span>          <span class="c">! get non-blank length of input line</span>
<a name="ln-5192"></a>   <span class="n">dum1</span><span class="p">(:)</span><span class="o">=</span><span class="s1">&#39; &#39;</span>                                         <span class="c">! initialize string to build output in</span>
<a name="ln-5193"></a>   <span class="n">id</span><span class="o">=</span><span class="n">mr</span><span class="o">-</span><span class="n">ml</span>                                            <span class="c">! check for window option !-! change to optional parameter(s)</span>
<a name="ln-5194"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-5195"></a>   <span class="n">len_old</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">old</span><span class="p">)</span>                                    <span class="c">! length of old substring to be replaced</span>
<a name="ln-5196"></a>   <span class="n">len_new</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">new</span><span class="p">)</span>                                    <span class="c">! length of new substring to replace old substring</span>
<a name="ln-5197"></a>   <span class="k">if</span><span class="p">(</span><span class="n">id</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                     <span class="c">! no window so change entire input string</span>
<a name="ln-5198"></a>      <span class="n">il</span><span class="o">=</span><span class="mi">1</span>                                             <span class="c">! il is left margin of window to change</span>
<a name="ln-5199"></a>      <span class="n">ir</span><span class="o">=</span><span class="n">maxlengthout</span>                                  <span class="c">! ir is right margin of window to change</span>
<a name="ln-5200"></a>      <span class="n">dum1</span><span class="p">(:)</span><span class="o">=</span><span class="s1">&#39; &#39;</span>                                      <span class="c">! begin with a blank line</span>
<a name="ln-5201"></a>   <span class="k">else</span>                                                <span class="c">! if window is set</span>
<a name="ln-5202"></a>      <span class="n">il</span><span class="o">=</span><span class="n">ml</span>                                            <span class="c">! use left margin</span>
<a name="ln-5203"></a>      <span class="n">ir</span><span class="o">=</span><span class="n">min0</span><span class="p">(</span><span class="n">mr</span><span class="p">,</span><span class="n">maxlengthout</span><span class="p">)</span>                         <span class="c">! use right margin or rightmost</span>
<a name="ln-5204"></a>      <span class="n">dum1</span><span class="o">=</span><span class="n">targetline</span><span class="p">(:</span><span class="n">il</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span>                           <span class="c">! begin with what&#39;s below margin</span>
<a name="ln-5205"></a>   <span class="k">endif</span>                                               <span class="c">! end of window settings</span>
<a name="ln-5206"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-5207"></a>   <span class="k">if</span><span class="p">(</span><span class="n">len_old</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                <span class="c">! c//new/ means insert new at beginning of line (or left margin)</span>
<a name="ln-5208"></a>      <span class="n">iichar</span><span class="o">=</span><span class="n">len_new</span> <span class="o">+</span> <span class="n">original_input_length</span>
<a name="ln-5209"></a>      <span class="k">if</span><span class="p">(</span><span class="n">iichar</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="n">maxlengthout</span><span class="p">)</span><span class="k">then</span>
<a name="ln-5210"></a><span class="k">         call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*substitute* new line will be too long&#39;</span><span class="p">)</span>
<a name="ln-5211"></a>         <span class="n">ier1</span><span class="o">=-</span><span class="mi">1</span>
<a name="ln-5212"></a>         <span class="k">if</span> <span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">ierr</span><span class="p">))</span><span class="n">ierr</span><span class="o">=</span><span class="n">ier1</span>
<a name="ln-5213"></a>         <span class="k">return</span>
<a name="ln-5214"></a><span class="k">      endif</span>
<a name="ln-5215"></a><span class="k">      if</span><span class="p">(</span><span class="n">len_new</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-5216"></a><span class="k">         </span><span class="n">dum1</span><span class="p">(</span><span class="n">il</span><span class="p">:)</span><span class="o">=</span><span class="n">new</span><span class="p">(:</span><span class="n">len_new</span><span class="p">)</span><span class="o">//</span><span class="n">targetline</span><span class="p">(</span><span class="n">il</span><span class="p">:</span><span class="n">original_input_length</span><span class="p">)</span>
<a name="ln-5217"></a>      <span class="k">else</span>
<a name="ln-5218"></a><span class="k">         </span><span class="n">dum1</span><span class="p">(</span><span class="n">il</span><span class="p">:)</span><span class="o">=</span><span class="n">targetline</span><span class="p">(</span><span class="n">il</span><span class="p">:</span><span class="n">original_input_length</span><span class="p">)</span>
<a name="ln-5219"></a>      <span class="k">endif</span>
<a name="ln-5220"></a><span class="k">      </span><span class="n">targetline</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">maxlengthout</span><span class="p">)</span><span class="o">=</span><span class="n">dum1</span><span class="p">(:</span><span class="n">maxlengthout</span><span class="p">)</span>
<a name="ln-5221"></a>      <span class="n">ier1</span><span class="o">=</span><span class="mi">1</span>                                           <span class="c">! made one change. actually, c/// should maybe return 0</span>
<a name="ln-5222"></a>      <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">ierr</span><span class="p">))</span><span class="n">ierr</span><span class="o">=</span><span class="n">ier1</span>
<a name="ln-5223"></a>      <span class="k">return</span>
<a name="ln-5224"></a><span class="k">   endif</span>
<a name="ln-5225"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-5226"></a>   <span class="n">iichar</span><span class="o">=</span><span class="n">il</span>                                           <span class="c">! place to put characters into output string</span>
<a name="ln-5227"></a>   <span class="n">ic</span><span class="o">=</span><span class="n">il</span>                                               <span class="c">! place looking at in input string</span>
<a name="ln-5228"></a>   <span class="n">loop</span><span class="p">:</span> <span class="k">do</span>
<a name="ln-5229"></a><span class="k">      </span><span class="n">ind</span><span class="o">=</span><span class="nb">index</span><span class="p">(</span><span class="n">targetline</span><span class="p">(</span><span class="n">ic</span><span class="p">:),</span><span class="n">old</span><span class="p">(:</span><span class="n">len_old</span><span class="p">))</span><span class="o">+</span><span class="n">ic</span><span class="o">-</span><span class="mi">1</span>    <span class="c">! try to find start of old string in remaining part of input in change window</span>
<a name="ln-5230"></a>      <span class="k">if</span><span class="p">(</span><span class="n">ind</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="n">ic</span><span class="o">-</span><span class="mf">1.</span><span class="nb">or</span><span class="p">.</span><span class="n">ind</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="n">ir</span><span class="p">)</span><span class="k">then</span>                 <span class="c">! did not find old string or found old string past edit window</span>
<a name="ln-5231"></a>         <span class="k">exit </span><span class="n">loop</span>                                     <span class="c">! no more changes left to make</span>
<a name="ln-5232"></a>      <span class="k">endif</span>
<a name="ln-5233"></a><span class="k">      </span><span class="n">ier1</span><span class="o">=</span><span class="n">ier1</span><span class="o">+</span><span class="mi">1</span>                                      <span class="c">! found an old string to change, so increment count of changes</span>
<a name="ln-5234"></a>      <span class="k">if</span><span class="p">(</span><span class="n">ind</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="n">ic</span><span class="p">)</span><span class="k">then</span>                                <span class="c">! if found old string past at current position in input string copy unchanged</span>
<a name="ln-5235"></a>         <span class="n">ladd</span><span class="o">=</span><span class="n">ind</span><span class="o">-</span><span class="n">ic</span>                                   <span class="c">! find length of character range to copy as-is from input to output</span>
<a name="ln-5236"></a>         <span class="k">if</span><span class="p">(</span><span class="n">iichar</span><span class="o">-</span><span class="mi">1</span><span class="o">+</span><span class="n">ladd</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="n">maxlengthout</span><span class="p">)</span><span class="k">then</span>
<a name="ln-5237"></a><span class="k">            </span><span class="n">ier1</span><span class="o">=-</span><span class="mi">1</span>
<a name="ln-5238"></a>            <span class="k">exit </span><span class="n">loop</span>
<a name="ln-5239"></a>         <span class="k">endif</span>
<a name="ln-5240"></a><span class="k">         </span><span class="n">dum1</span><span class="p">(</span><span class="n">iichar</span><span class="p">:)</span><span class="o">=</span><span class="n">targetline</span><span class="p">(</span><span class="n">ic</span><span class="p">:</span><span class="n">ind</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span>
<a name="ln-5241"></a>         <span class="n">iichar</span><span class="o">=</span><span class="n">iichar</span><span class="o">+</span><span class="n">ladd</span>
<a name="ln-5242"></a>      <span class="k">endif</span>
<a name="ln-5243"></a><span class="k">      if</span><span class="p">(</span><span class="n">iichar</span><span class="o">-</span><span class="mi">1</span><span class="o">+</span><span class="n">len_new</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="n">maxlengthout</span><span class="p">)</span><span class="k">then</span>
<a name="ln-5244"></a><span class="k">         </span><span class="n">ier1</span><span class="o">=-</span><span class="mi">2</span>
<a name="ln-5245"></a>         <span class="k">exit </span><span class="n">loop</span>
<a name="ln-5246"></a>      <span class="k">endif</span>
<a name="ln-5247"></a><span class="k">      if</span><span class="p">(</span><span class="n">len_new</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-5248"></a><span class="k">         </span><span class="n">dum1</span><span class="p">(</span><span class="n">iichar</span><span class="p">:)</span><span class="o">=</span><span class="n">new</span><span class="p">(:</span><span class="n">len_new</span><span class="p">)</span>
<a name="ln-5249"></a>         <span class="n">iichar</span><span class="o">=</span><span class="n">iichar</span><span class="o">+</span><span class="n">len_new</span>
<a name="ln-5250"></a>      <span class="k">endif</span>
<a name="ln-5251"></a><span class="k">      </span><span class="n">ic</span><span class="o">=</span><span class="n">ind</span><span class="o">+</span><span class="n">len_old</span>
<a name="ln-5252"></a>   <span class="k">enddo </span><span class="n">loop</span>
<a name="ln-5253"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-5254"></a>   <span class="k">select case</span> <span class="p">(</span><span class="n">ier1</span><span class="p">)</span>
<a name="ln-5255"></a>   <span class="k">case</span> <span class="p">(:</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span>
<a name="ln-5256"></a>      <span class="k">call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*substitute* new line will be too long&#39;</span><span class="p">)</span>
<a name="ln-5257"></a>   <span class="k">case</span> <span class="p">(</span><span class="mi">0</span><span class="p">)</span>                                                <span class="c">! there were no changes made to the window</span>
<a name="ln-5258"></a>   <span class="k">case </span><span class="n">default</span>
<a name="ln-5259"></a>      <span class="n">ladd</span><span class="o">=</span><span class="n">original_input_length</span><span class="o">-</span><span class="n">ic</span>
<a name="ln-5260"></a>      <span class="k">if</span><span class="p">(</span><span class="n">iichar</span><span class="o">+</span><span class="n">ladd</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="n">maxlengthout</span><span class="p">)</span><span class="k">then</span>
<a name="ln-5261"></a><span class="k">         call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s1">&#39;*substitute* new line will be too long&#39;</span><span class="p">)</span>
<a name="ln-5262"></a>         <span class="n">ier1</span><span class="o">=-</span><span class="mi">1</span>
<a name="ln-5263"></a>         <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">ierr</span><span class="p">))</span><span class="n">ierr</span><span class="o">=</span><span class="n">ier1</span>
<a name="ln-5264"></a>         <span class="k">return</span>
<a name="ln-5265"></a><span class="k">      endif</span>
<a name="ln-5266"></a><span class="k">      if</span><span class="p">(</span><span class="n">ic</span><span class="p">.</span><span class="n">lt</span><span class="p">.</span><span class="nb">len</span><span class="p">(</span><span class="n">targetline</span><span class="p">))</span><span class="k">then</span>
<a name="ln-5267"></a><span class="k">         </span><span class="n">dum1</span><span class="p">(</span><span class="n">iichar</span><span class="p">:)</span><span class="o">=</span><span class="n">targetline</span><span class="p">(</span><span class="n">ic</span><span class="p">:</span><span class="nb">max</span><span class="p">(</span><span class="n">ic</span><span class="p">,</span><span class="n">original_input_length</span><span class="p">))</span>
<a name="ln-5268"></a>      <span class="k">endif</span>
<a name="ln-5269"></a><span class="k">      </span><span class="n">targetline</span><span class="o">=</span><span class="n">dum1</span><span class="p">(:</span><span class="n">maxlengthout</span><span class="p">)</span>
<a name="ln-5270"></a>   <span class="k">end select</span>
<a name="ln-5271"></a><span class="k">   if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">ierr</span><span class="p">))</span><span class="n">ierr</span><span class="o">=</span><span class="n">ier1</span>
<a name="ln-5272"></a><span class="c">!-----------------------------------------------------------------------------------------------------------------------------------</span>
<a name="ln-5273"></a><span class="k">end subroutine </span><span class="n">substitute</span>
<a name="ln-5274"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-5275"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()=</span>
<a name="ln-5276"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-5277"></a><span class="c">!&gt;</span>
<a name="ln-5278"></a><span class="c">!!##NAME</span>
<a name="ln-5279"></a><span class="c">!!    locate(3f) - [M_CLI2] finds the index where a string is found or</span>
<a name="ln-5280"></a><span class="c">!!                 should be in a sorted array</span>
<a name="ln-5281"></a><span class="c">!!    (LICENSE:PD)</span>
<a name="ln-5282"></a><span class="c">!!</span>
<a name="ln-5283"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-5284"></a><span class="c">!!</span>
<a name="ln-5285"></a><span class="c">!!   subroutine locate(list,value,place,ier,errmsg)</span>
<a name="ln-5286"></a><span class="c">!!</span>
<a name="ln-5287"></a><span class="c">!!    character(len=:)|doubleprecision|real|integer,allocatable :: list(:)</span>
<a name="ln-5288"></a><span class="c">!!    character(len=*)|doubleprecision|real|integer,intent(in)  :: value</span>
<a name="ln-5289"></a><span class="c">!!    integer, intent(out)                  :: PLACE</span>
<a name="ln-5290"></a><span class="c">!!</span>
<a name="ln-5291"></a><span class="c">!!    integer, intent(out),optional         :: IER</span>
<a name="ln-5292"></a><span class="c">!!    character(len=*),intent(out),optional :: ERRMSG</span>
<a name="ln-5293"></a><span class="c">!!</span>
<a name="ln-5294"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-5295"></a><span class="c">!!</span>
<a name="ln-5296"></a><span class="c">!!    LOCATE(3f) finds the index where the VALUE is found or should</span>
<a name="ln-5297"></a><span class="c">!!    be found in an array. The array must be sorted in descending</span>
<a name="ln-5298"></a><span class="c">!!    order (highest at top). If VALUE is not found it returns the index</span>
<a name="ln-5299"></a><span class="c">!!    where the name should be placed at with a negative sign.</span>
<a name="ln-5300"></a><span class="c">!!</span>
<a name="ln-5301"></a><span class="c">!!    The array and list must be of the same type (CHARACTER, DOUBLEPRECISION,</span>
<a name="ln-5302"></a><span class="c">!!    REAL,INTEGER)</span>
<a name="ln-5303"></a><span class="c">!!</span>
<a name="ln-5304"></a><span class="c">!!##OPTIONS</span>
<a name="ln-5305"></a><span class="c">!!</span>
<a name="ln-5306"></a><span class="c">!!    VALUE         the value to locate in the list.</span>
<a name="ln-5307"></a><span class="c">!!    LIST          is the list array.</span>
<a name="ln-5308"></a><span class="c">!!</span>
<a name="ln-5309"></a><span class="c">!!##RETURNS</span>
<a name="ln-5310"></a><span class="c">!!    PLACE         is the subscript that the entry was found at if it is</span>
<a name="ln-5311"></a><span class="c">!!                  greater than zero(0).</span>
<a name="ln-5312"></a><span class="c">!!</span>
<a name="ln-5313"></a><span class="c">!!                  If PLACE is negative, the absolute value of</span>
<a name="ln-5314"></a><span class="c">!!                  PLACE indicates the subscript value where the</span>
<a name="ln-5315"></a><span class="c">!!                  new entry should be placed in order to keep the</span>
<a name="ln-5316"></a><span class="c">!!                  list alphabetized.</span>
<a name="ln-5317"></a><span class="c">!!</span>
<a name="ln-5318"></a><span class="c">!!    IER           is zero(0) if no error occurs.</span>
<a name="ln-5319"></a><span class="c">!!                  If an error occurs and IER is not</span>
<a name="ln-5320"></a><span class="c">!!                  present, the program is stopped.</span>
<a name="ln-5321"></a><span class="c">!!</span>
<a name="ln-5322"></a><span class="c">!!    ERRMSG        description of any error</span>
<a name="ln-5323"></a><span class="c">!!</span>
<a name="ln-5324"></a><span class="c">!!##EXAMPLES</span>
<a name="ln-5325"></a><span class="c">!!</span>
<a name="ln-5326"></a><span class="c">!!</span>
<a name="ln-5327"></a><span class="c">!! Find if a string is in a sorted array, and insert the string into</span>
<a name="ln-5328"></a><span class="c">!! the list if it is not present ...</span>
<a name="ln-5329"></a><span class="c">!!</span>
<a name="ln-5330"></a><span class="c">!!     program demo_locate</span>
<a name="ln-5331"></a><span class="c">!!     use M_sort, only : sort_shell</span>
<a name="ln-5332"></a><span class="c">!!     use M_CLI2, only : locate</span>
<a name="ln-5333"></a><span class="c">!!     implicit none</span>
<a name="ln-5334"></a><span class="c">!!     character(len=:),allocatable  :: arr(:)</span>
<a name="ln-5335"></a><span class="c">!!     integer                       :: i</span>
<a name="ln-5336"></a><span class="c">!!</span>
<a name="ln-5337"></a><span class="c">!!     arr=[character(len=20) :: &#39;&#39;, &#39;ZZZ&#39;, &#39;aaa&#39;, &#39;b&#39;, &#39;xxx&#39; ]</span>
<a name="ln-5338"></a><span class="c">!!     ! make sure sorted in descending order</span>
<a name="ln-5339"></a><span class="c">!!     call sort_shell(arr,order=&#39;d&#39;)</span>
<a name="ln-5340"></a><span class="c">!!</span>
<a name="ln-5341"></a><span class="c">!!     call update(arr,&#39;b&#39;)</span>
<a name="ln-5342"></a><span class="c">!!     call update(arr,&#39;[&#39;)</span>
<a name="ln-5343"></a><span class="c">!!     call update(arr,&#39;c&#39;)</span>
<a name="ln-5344"></a><span class="c">!!     call update(arr,&#39;ZZ&#39;)</span>
<a name="ln-5345"></a><span class="c">!!     call update(arr,&#39;ZZZZ&#39;)</span>
<a name="ln-5346"></a><span class="c">!!     call update(arr,&#39;z&#39;)</span>
<a name="ln-5347"></a><span class="c">!!</span>
<a name="ln-5348"></a><span class="c">!!     contains</span>
<a name="ln-5349"></a><span class="c">!!     subroutine update(arr,string)</span>
<a name="ln-5350"></a><span class="c">!!     character(len=:),allocatable :: arr(:)</span>
<a name="ln-5351"></a><span class="c">!!     character(len=*)             :: string</span>
<a name="ln-5352"></a><span class="c">!!     integer                      :: place, plus, ii, end</span>
<a name="ln-5353"></a><span class="c">!!     ! find where string is or should be</span>
<a name="ln-5354"></a><span class="c">!!     call locate(arr,string,place)</span>
<a name="ln-5355"></a><span class="c">!!     write(*,*)&#39;for &quot;&#39;//string//&#39;&quot; index is &#39;,place, size(arr)</span>
<a name="ln-5356"></a><span class="c">!!     ! if string was not found insert it</span>
<a name="ln-5357"></a><span class="c">!!     if(place.lt.1)then</span>
<a name="ln-5358"></a><span class="c">!!        plus=abs(place)</span>
<a name="ln-5359"></a><span class="c">!!        ii=len(arr)</span>
<a name="ln-5360"></a><span class="c">!!        end=size(arr)</span>
<a name="ln-5361"></a><span class="c">!!        ! empty array</span>
<a name="ln-5362"></a><span class="c">!!        if(end.eq.0)then</span>
<a name="ln-5363"></a><span class="c">!!           arr=[character(len=ii) :: string ]</span>
<a name="ln-5364"></a><span class="c">!!        ! put in front of array</span>
<a name="ln-5365"></a><span class="c">!!        elseif(plus.eq.1)then</span>
<a name="ln-5366"></a><span class="c">!!           arr=[character(len=ii) :: string, arr]</span>
<a name="ln-5367"></a><span class="c">!!        ! put at end of array</span>
<a name="ln-5368"></a><span class="c">!!        elseif(plus.eq.end)then</span>
<a name="ln-5369"></a><span class="c">!!           arr=[character(len=ii) :: arr, string ]</span>
<a name="ln-5370"></a><span class="c">!!        ! put in middle of array</span>
<a name="ln-5371"></a><span class="c">!!        else</span>
<a name="ln-5372"></a><span class="c">!!           arr=[character(len=ii) :: arr(:plus-1), string,arr(plus:) ]</span>
<a name="ln-5373"></a><span class="c">!!        endif</span>
<a name="ln-5374"></a><span class="c">!!        ! show array</span>
<a name="ln-5375"></a><span class="c">!!        write(*,&#39;(&quot;SIZE=&quot;,i0,1x,*(a,&quot;,&quot;))&#39;)end,(trim(arr(i)),i=1,end)</span>
<a name="ln-5376"></a><span class="c">!!     endif</span>
<a name="ln-5377"></a><span class="c">!!     end subroutine update</span>
<a name="ln-5378"></a><span class="c">!!     end program demo_locate</span>
<a name="ln-5379"></a><span class="c">!!</span>
<a name="ln-5380"></a><span class="c">!!   Results:</span>
<a name="ln-5381"></a><span class="c">!!</span>
<a name="ln-5382"></a><span class="c">!!     for &quot;b&quot; index is            2           5</span>
<a name="ln-5383"></a><span class="c">!!     for &quot;[&quot; index is           -4           5</span>
<a name="ln-5384"></a><span class="c">!!    SIZE=5 xxx,b,aaa,[,ZZZ,</span>
<a name="ln-5385"></a><span class="c">!!     for &quot;c&quot; index is           -2           6</span>
<a name="ln-5386"></a><span class="c">!!    SIZE=6 xxx,c,b,aaa,[,ZZZ,</span>
<a name="ln-5387"></a><span class="c">!!     for &quot;ZZ&quot; index is           -7           7</span>
<a name="ln-5388"></a><span class="c">!!    SIZE=7 xxx,c,b,aaa,[,ZZZ,,</span>
<a name="ln-5389"></a><span class="c">!!     for &quot;ZZZZ&quot; index is           -6           8</span>
<a name="ln-5390"></a><span class="c">!!    SIZE=8 xxx,c,b,aaa,[,ZZZZ,ZZZ,,</span>
<a name="ln-5391"></a><span class="c">!!     for &quot;z&quot; index is           -1           9</span>
<a name="ln-5392"></a><span class="c">!!    SIZE=9 z,xxx,c,b,aaa,[,ZZZZ,ZZZ,,</span>
<a name="ln-5393"></a><span class="c">!!</span>
<a name="ln-5394"></a><span class="c">!!##AUTHOR</span>
<a name="ln-5395"></a><span class="c">!!    1989,2017 John S. Urban</span>
<a name="ln-5396"></a><span class="c">!!##LICENSE</span>
<a name="ln-5397"></a><span class="c">!!    Public Domain</span>
<a name="ln-5398"></a><span class="k">subroutine </span><span class="n">locate_c</span><span class="p">(</span><span class="n">list</span><span class="p">,</span><span class="k">value</span><span class="p">,</span><span class="n">place</span><span class="p">,</span><span class="n">ier</span><span class="p">,</span><span class="n">errmsg</span><span class="p">)</span>
<a name="ln-5399"></a>
<a name="ln-5400"></a><span class="c">! ident_29=&quot;@(#)M_CLI2::locate_c(3f): find PLACE in sorted character array where VALUE can be found or should be placed&quot;</span>
<a name="ln-5401"></a>
<a name="ln-5402"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>             <span class="kd">::</span> <span class="k">value</span>
<a name="ln-5403"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span>                     <span class="kd">::</span> <span class="n">place</span>
<a name="ln-5404"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>            <span class="kd">::</span> <span class="n">list</span><span class="p">(:)</span>
<a name="ln-5405"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">),</span><span class="k">optional</span>            <span class="kd">::</span> <span class="n">ier</span>
<a name="ln-5406"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">),</span><span class="k">optional</span>   <span class="kd">::</span> <span class="n">errmsg</span>
<a name="ln-5407"></a><span class="kt">integer</span>                                 <span class="kd">::</span> <span class="n">i</span>
<a name="ln-5408"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>            <span class="kd">::</span> <span class="n">message</span>
<a name="ln-5409"></a><span class="kt">integer</span>                                 <span class="kd">::</span> <span class="n">arraysize</span>
<a name="ln-5410"></a><span class="kt">integer</span>                                 <span class="kd">::</span> <span class="n">maxtry</span>
<a name="ln-5411"></a><span class="kt">integer</span>                                 <span class="kd">::</span> <span class="n">imin</span><span class="p">,</span> <span class="n">imax</span>
<a name="ln-5412"></a><span class="kt">integer</span>                                 <span class="kd">::</span> <span class="n">error</span>
<a name="ln-5413"></a>   <span class="k">if</span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="nb">allocated</span><span class="p">(</span><span class="n">list</span><span class="p">))</span><span class="k">then</span>
<a name="ln-5414"></a><span class="k">      </span><span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="nb">max</span><span class="p">(</span><span class="nb">len_trim</span><span class="p">(</span><span class="k">value</span><span class="p">),</span><span class="mi">2</span><span class="p">))</span> <span class="kd">::</span> <span class="p">]</span>
<a name="ln-5415"></a>   <span class="k">endif</span>
<a name="ln-5416"></a><span class="k">   </span><span class="n">arraysize</span><span class="o">=</span><span class="n">size</span><span class="p">(</span><span class="n">list</span><span class="p">)</span>
<a name="ln-5417"></a>
<a name="ln-5418"></a>   <span class="n">error</span><span class="o">=</span><span class="mi">0</span>
<a name="ln-5419"></a>   <span class="k">if</span><span class="p">(</span><span class="n">arraysize</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-5420"></a><span class="k">      </span><span class="n">maxtry</span><span class="o">=</span><span class="mi">0</span>
<a name="ln-5421"></a>      <span class="n">place</span><span class="o">=-</span><span class="mi">1</span>
<a name="ln-5422"></a>   <span class="k">else</span>
<a name="ln-5423"></a><span class="k">      </span><span class="n">maxtry</span><span class="o">=</span><span class="nb">int</span><span class="p">(</span><span class="nb">log</span><span class="p">(</span><span class="nb">float</span><span class="p">(</span><span class="n">arraysize</span><span class="p">))</span><span class="o">/</span><span class="nb">log</span><span class="p">(</span><span class="mf">2.0</span><span class="p">)</span><span class="o">+</span><span class="mf">1.0</span><span class="p">)</span>
<a name="ln-5424"></a>      <span class="n">place</span><span class="o">=</span><span class="p">(</span><span class="n">arraysize</span><span class="o">+</span><span class="mi">1</span><span class="p">)</span><span class="o">/</span><span class="mi">2</span>
<a name="ln-5425"></a>   <span class="k">endif</span>
<a name="ln-5426"></a><span class="k">   </span><span class="n">imin</span><span class="o">=</span><span class="mi">1</span>
<a name="ln-5427"></a>   <span class="n">imax</span><span class="o">=</span><span class="n">arraysize</span>
<a name="ln-5428"></a>   <span class="n">message</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-5429"></a>
<a name="ln-5430"></a>   <span class="n">LOOP</span><span class="p">:</span> <span class="k">block</span>
<a name="ln-5431"></a><span class="k">   do </span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">maxtry</span>
<a name="ln-5432"></a>
<a name="ln-5433"></a>      <span class="k">if</span><span class="p">(</span><span class="k">value</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="n">list</span><span class="p">(</span><span class="n">PLACE</span><span class="p">))</span><span class="k">then</span>
<a name="ln-5434"></a><span class="k">         exit </span><span class="n">LOOP</span>
<a name="ln-5435"></a>      <span class="n">elseif</span><span class="p">(</span><span class="k">value</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="n">list</span><span class="p">(</span><span class="n">place</span><span class="p">))</span><span class="k">then</span>
<a name="ln-5436"></a><span class="k">         </span><span class="n">imax</span><span class="o">=</span><span class="n">place</span><span class="o">-</span><span class="mi">1</span>
<a name="ln-5437"></a>      <span class="k">else</span>
<a name="ln-5438"></a><span class="k">         </span><span class="n">imin</span><span class="o">=</span><span class="n">place</span><span class="o">+</span><span class="mi">1</span>
<a name="ln-5439"></a>      <span class="k">endif</span>
<a name="ln-5440"></a>
<a name="ln-5441"></a><span class="k">      if</span><span class="p">(</span><span class="n">imin</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="n">imax</span><span class="p">)</span><span class="k">then</span>
<a name="ln-5442"></a><span class="k">         </span><span class="n">place</span><span class="o">=-</span><span class="n">imin</span>
<a name="ln-5443"></a>         <span class="k">if</span><span class="p">(</span><span class="nb">iabs</span><span class="p">(</span><span class="n">place</span><span class="p">).</span><span class="n">gt</span><span class="p">.</span><span class="n">arraysize</span><span class="p">)</span><span class="k">then</span> <span class="c">! ran off end of list. Where new value should go or an unsorted input array&#39;</span>
<a name="ln-5444"></a>            <span class="k">exit </span><span class="n">LOOP</span>
<a name="ln-5445"></a>         <span class="k">endif</span>
<a name="ln-5446"></a><span class="k">         exit </span><span class="n">LOOP</span>
<a name="ln-5447"></a>      <span class="k">endif</span>
<a name="ln-5448"></a>
<a name="ln-5449"></a><span class="k">      </span><span class="n">place</span><span class="o">=</span><span class="p">(</span><span class="n">imax</span><span class="o">+</span><span class="n">imin</span><span class="p">)</span><span class="o">/</span><span class="mi">2</span>
<a name="ln-5450"></a>
<a name="ln-5451"></a>      <span class="k">if</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="n">arraysize</span><span class="p">.</span><span class="nb">or</span><span class="p">.</span><span class="n">place</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-5452"></a><span class="k">         </span><span class="n">message</span><span class="o">=</span><span class="s1">&#39;*locate* error: search is out of bounds of list. Probably an unsorted input array&#39;</span>
<a name="ln-5453"></a>         <span class="n">error</span><span class="o">=-</span><span class="mi">1</span>
<a name="ln-5454"></a>         <span class="k">exit </span><span class="n">LOOP</span>
<a name="ln-5455"></a>      <span class="k">endif</span>
<a name="ln-5456"></a>
<a name="ln-5457"></a><span class="k">   enddo</span>
<a name="ln-5458"></a><span class="k">   </span><span class="n">message</span><span class="o">=</span><span class="s1">&#39;*locate* exceeded allowed tries. Probably an unsorted input array&#39;</span>
<a name="ln-5459"></a>   <span class="k">endblock </span><span class="n">LOOP</span>
<a name="ln-5460"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">ier</span><span class="p">))</span><span class="k">then</span>
<a name="ln-5461"></a><span class="k">      </span><span class="n">ier</span><span class="o">=</span><span class="n">error</span>
<a name="ln-5462"></a>   <span class="n">elseif</span><span class="p">(</span><span class="n">error</span><span class="p">.</span><span class="n">ne</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-5463"></a><span class="k">      write</span><span class="p">(</span><span class="n">warn</span><span class="p">,</span><span class="o">*</span><span class="p">)</span><span class="n">message</span><span class="o">//</span><span class="s1">&#39; VALUE=&#39;</span><span class="p">,</span><span class="nb">trim</span><span class="p">(</span><span class="k">value</span><span class="p">)</span><span class="o">//</span><span class="s1">&#39; PLACE=&#39;</span><span class="p">,</span><span class="n">place</span>
<a name="ln-5464"></a>      <span class="k">call </span><span class="n">mystop</span><span class="p">(</span><span class="o">-</span><span class="mi">24</span><span class="p">,</span><span class="s1">&#39;(*locate_c* &#39;</span><span class="o">//</span><span class="n">message</span><span class="p">)</span>
<a name="ln-5465"></a>   <span class="k">endif</span>
<a name="ln-5466"></a><span class="k">   if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">errmsg</span><span class="p">))</span><span class="k">then</span>
<a name="ln-5467"></a><span class="k">      </span><span class="n">errmsg</span><span class="o">=</span><span class="n">message</span>
<a name="ln-5468"></a>   <span class="k">endif</span>
<a name="ln-5469"></a><span class="k">end subroutine </span><span class="n">locate_c</span>
<a name="ln-5470"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-5471"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()=</span>
<a name="ln-5472"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-5473"></a><span class="c">!&gt;</span>
<a name="ln-5474"></a><span class="c">!!##NAME</span>
<a name="ln-5475"></a><span class="c">!!    remove(3f) - [M_CLI2] remove entry from an allocatable array at specified position</span>
<a name="ln-5476"></a><span class="c">!!    (LICENSE:PD)</span>
<a name="ln-5477"></a><span class="c">!!</span>
<a name="ln-5478"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-5479"></a><span class="c">!!</span>
<a name="ln-5480"></a><span class="c">!!   subroutine remove(list,place)</span>
<a name="ln-5481"></a><span class="c">!!</span>
<a name="ln-5482"></a><span class="c">!!    character(len=:)|doubleprecision|real|integer,intent(inout) :: list(:)</span>
<a name="ln-5483"></a><span class="c">!!    integer, intent(out) :: PLACE</span>
<a name="ln-5484"></a><span class="c">!!</span>
<a name="ln-5485"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-5486"></a><span class="c">!!</span>
<a name="ln-5487"></a><span class="c">!!    Remove a value from an allocatable array at the specified index.</span>
<a name="ln-5488"></a><span class="c">!!    The array is assumed to be sorted in descending order. It may be of</span>
<a name="ln-5489"></a><span class="c">!!    type CHARACTER, DOUBLEPRECISION, REAL, or INTEGER.</span>
<a name="ln-5490"></a><span class="c">!!</span>
<a name="ln-5491"></a><span class="c">!!##OPTIONS</span>
<a name="ln-5492"></a><span class="c">!!</span>
<a name="ln-5493"></a><span class="c">!!    list    is the list array.</span>
<a name="ln-5494"></a><span class="c">!!    PLACE   is the subscript for the entry that should be removed</span>
<a name="ln-5495"></a><span class="c">!!</span>
<a name="ln-5496"></a><span class="c">!!##EXAMPLES</span>
<a name="ln-5497"></a><span class="c">!!</span>
<a name="ln-5498"></a><span class="c">!!</span>
<a name="ln-5499"></a><span class="c">!! Sample program</span>
<a name="ln-5500"></a><span class="c">!!</span>
<a name="ln-5501"></a><span class="c">!!     program demo_remove</span>
<a name="ln-5502"></a><span class="c">!!     use M_sort, only : sort_shell</span>
<a name="ln-5503"></a><span class="c">!!     use M_CLI2, only : locate, remove</span>
<a name="ln-5504"></a><span class="c">!!     implicit none</span>
<a name="ln-5505"></a><span class="c">!!     character(len=:),allocatable :: arr(:)</span>
<a name="ln-5506"></a><span class="c">!!     integer                       :: i</span>
<a name="ln-5507"></a><span class="c">!!     integer                       :: end</span>
<a name="ln-5508"></a><span class="c">!!</span>
<a name="ln-5509"></a><span class="c">!!     arr=[character(len=20) :: &#39;&#39;, &#39;ZZZ&#39;, &#39;Z&#39;, &#39;aaa&#39;, &#39;b&#39;, &#39;b&#39;, &#39;ab&#39;, &#39;bb&#39;, &#39;xxx&#39; ]</span>
<a name="ln-5510"></a><span class="c">!!     ! make sure sorted in descending order</span>
<a name="ln-5511"></a><span class="c">!!     call sort_shell(arr,order=&#39;d&#39;)</span>
<a name="ln-5512"></a><span class="c">!!</span>
<a name="ln-5513"></a><span class="c">!!     end=size(arr)</span>
<a name="ln-5514"></a><span class="c">!!     write(*,&#39;(&quot;SIZE=&quot;,i0,1x,*(a,&quot;,&quot;))&#39;)end,(trim(arr(i)),i=1,end)</span>
<a name="ln-5515"></a><span class="c">!!     call remove(arr,1)</span>
<a name="ln-5516"></a><span class="c">!!     end=size(arr)</span>
<a name="ln-5517"></a><span class="c">!!     write(*,&#39;(&quot;SIZE=&quot;,i0,1x,*(a,&quot;,&quot;))&#39;)end,(trim(arr(i)),i=1,end)</span>
<a name="ln-5518"></a><span class="c">!!     call remove(arr,4)</span>
<a name="ln-5519"></a><span class="c">!!     end=size(arr)</span>
<a name="ln-5520"></a><span class="c">!!     write(*,&#39;(&quot;SIZE=&quot;,i0,1x,*(a,&quot;,&quot;))&#39;)end,(trim(arr(i)),i=1,end)</span>
<a name="ln-5521"></a><span class="c">!!</span>
<a name="ln-5522"></a><span class="c">!!     end program demo_remove</span>
<a name="ln-5523"></a><span class="c">!!</span>
<a name="ln-5524"></a><span class="c">!!   Results:</span>
<a name="ln-5525"></a><span class="c">!!</span>
<a name="ln-5526"></a><span class="c">!!    Expected output</span>
<a name="ln-5527"></a><span class="c">!!</span>
<a name="ln-5528"></a><span class="c">!!     SIZE=9 xxx,bb,b,b,ab,aaa,ZZZ,Z,,</span>
<a name="ln-5529"></a><span class="c">!!     SIZE=8 bb,b,b,ab,aaa,ZZZ,Z,,</span>
<a name="ln-5530"></a><span class="c">!!     SIZE=7 bb,b,b,aaa,ZZZ,Z,,</span>
<a name="ln-5531"></a><span class="c">!!</span>
<a name="ln-5532"></a><span class="c">!!##AUTHOR</span>
<a name="ln-5533"></a><span class="c">!!    1989,2017 John S. Urban</span>
<a name="ln-5534"></a><span class="c">!!##LICENSE</span>
<a name="ln-5535"></a><span class="c">!!    Public Domain</span>
<a name="ln-5536"></a><span class="k">subroutine </span><span class="n">remove_c</span><span class="p">(</span><span class="n">list</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-5537"></a>
<a name="ln-5538"></a><span class="c">! ident_30=&quot;@(#)M_CLI2::remove_c(3fp): remove string from allocatable string array at specified position&quot;</span>
<a name="ln-5539"></a>
<a name="ln-5540"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">list</span><span class="p">(:)</span>
<a name="ln-5541"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>           <span class="kd">::</span> <span class="n">place</span>
<a name="ln-5542"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">ii</span><span class="p">,</span> <span class="k">end</span>
<a name="ln-5543"></a><span class="k">   if</span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="nb">allocated</span><span class="p">(</span><span class="n">list</span><span class="p">))</span><span class="k">then</span>
<a name="ln-5544"></a><span class="k">      </span><span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">2</span><span class="p">)</span> <span class="kd">::</span> <span class="p">]</span>
<a name="ln-5545"></a>   <span class="k">endif</span>
<a name="ln-5546"></a><span class="k">   </span><span class="n">ii</span><span class="o">=</span><span class="nb">len</span><span class="p">(</span><span class="n">list</span><span class="p">)</span>
<a name="ln-5547"></a>   <span class="k">end</span><span class="o">=</span><span class="n">size</span><span class="p">(</span><span class="n">list</span><span class="p">)</span>
<a name="ln-5548"></a>   <span class="k">if</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="mf">0.</span><span class="nb">or</span><span class="p">.</span><span class="n">place</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="k">end</span><span class="p">)</span><span class="k">then</span>                       <span class="c">! index out of bounds of array</span>
<a name="ln-5549"></a>   <span class="n">elseif</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="k">end</span><span class="p">)</span><span class="k">then</span>                                 <span class="c">! remove from array</span>
<a name="ln-5550"></a>      <span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="n">ii</span><span class="p">)</span> <span class="kd">::</span> <span class="n">list</span><span class="p">(:</span><span class="n">place</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span> <span class="p">]</span>
<a name="ln-5551"></a>   <span class="k">else</span>
<a name="ln-5552"></a><span class="k">      </span><span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="n">ii</span><span class="p">)</span> <span class="kd">::</span> <span class="n">list</span><span class="p">(:</span><span class="n">place</span><span class="o">-</span><span class="mi">1</span><span class="p">),</span> <span class="n">list</span><span class="p">(</span><span class="n">place</span><span class="o">+</span><span class="mi">1</span><span class="p">:)</span> <span class="p">]</span>
<a name="ln-5553"></a>   <span class="k">endif</span>
<a name="ln-5554"></a><span class="k">end subroutine </span><span class="n">remove_c</span>
<a name="ln-5555"></a><span class="k">subroutine </span><span class="n">remove_l</span><span class="p">(</span><span class="n">list</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-5556"></a>
<a name="ln-5557"></a><span class="c">! ident_31=&quot;@(#)M_CLI2::remove_l(3fp): remove value from allocatable array at specified position&quot;</span>
<a name="ln-5558"></a>
<a name="ln-5559"></a><span class="kt">logical</span><span class="p">,</span><span class="k">allocatable</span>    <span class="kd">::</span> <span class="n">list</span><span class="p">(:)</span>
<a name="ln-5560"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>     <span class="kd">::</span> <span class="n">place</span>
<a name="ln-5561"></a><span class="kt">integer</span>                <span class="kd">::</span> <span class="k">end</span>
<a name="ln-5562"></a>
<a name="ln-5563"></a><span class="k">   if</span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="nb">allocated</span><span class="p">(</span><span class="n">list</span><span class="p">))</span><span class="k">then</span>
<a name="ln-5564"></a><span class="k">      </span><span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="kt">logical</span> <span class="kd">::</span> <span class="p">]</span>
<a name="ln-5565"></a>   <span class="k">endif</span>
<a name="ln-5566"></a><span class="k">   end</span><span class="o">=</span><span class="n">size</span><span class="p">(</span><span class="n">list</span><span class="p">)</span>
<a name="ln-5567"></a>   <span class="k">if</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="mf">0.</span><span class="nb">or</span><span class="p">.</span><span class="n">place</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="k">end</span><span class="p">)</span><span class="k">then</span>                       <span class="c">! index out of bounds of array</span>
<a name="ln-5568"></a>   <span class="n">elseif</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="k">end</span><span class="p">)</span><span class="k">then</span>                                 <span class="c">! remove from array</span>
<a name="ln-5569"></a>      <span class="n">list</span><span class="o">=</span><span class="p">[</span> <span class="n">list</span><span class="p">(:</span><span class="n">place</span><span class="o">-</span><span class="mi">1</span><span class="p">)]</span>
<a name="ln-5570"></a>   <span class="k">else</span>
<a name="ln-5571"></a><span class="k">      </span><span class="n">list</span><span class="o">=</span><span class="p">[</span> <span class="n">list</span><span class="p">(:</span><span class="n">place</span><span class="o">-</span><span class="mi">1</span><span class="p">),</span> <span class="n">list</span><span class="p">(</span><span class="n">place</span><span class="o">+</span><span class="mi">1</span><span class="p">:)</span> <span class="p">]</span>
<a name="ln-5572"></a>   <span class="k">endif</span>
<a name="ln-5573"></a>
<a name="ln-5574"></a><span class="k">end subroutine </span><span class="n">remove_l</span>
<a name="ln-5575"></a><span class="k">subroutine </span><span class="n">remove_i</span><span class="p">(</span><span class="n">list</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-5576"></a>
<a name="ln-5577"></a><span class="c">! ident_32=&quot;@(#)M_CLI2::remove_i(3fp): remove value from allocatable array at specified position&quot;</span>
<a name="ln-5578"></a><span class="kt">integer</span><span class="p">,</span><span class="k">allocatable</span>    <span class="kd">::</span> <span class="n">list</span><span class="p">(:)</span>
<a name="ln-5579"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>     <span class="kd">::</span> <span class="n">place</span>
<a name="ln-5580"></a><span class="kt">integer</span>                <span class="kd">::</span> <span class="k">end</span>
<a name="ln-5581"></a>
<a name="ln-5582"></a><span class="k">   if</span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="nb">allocated</span><span class="p">(</span><span class="n">list</span><span class="p">))</span><span class="k">then</span>
<a name="ln-5583"></a><span class="k">      </span><span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="kt">integer</span> <span class="kd">::</span> <span class="p">]</span>
<a name="ln-5584"></a>   <span class="k">endif</span>
<a name="ln-5585"></a><span class="k">   end</span><span class="o">=</span><span class="n">size</span><span class="p">(</span><span class="n">list</span><span class="p">)</span>
<a name="ln-5586"></a>   <span class="k">if</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="mf">0.</span><span class="nb">or</span><span class="p">.</span><span class="n">place</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="k">end</span><span class="p">)</span><span class="k">then</span>                       <span class="c">! index out of bounds of array</span>
<a name="ln-5587"></a>   <span class="n">elseif</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="k">end</span><span class="p">)</span><span class="k">then</span>                                 <span class="c">! remove from array</span>
<a name="ln-5588"></a>      <span class="n">list</span><span class="o">=</span><span class="p">[</span> <span class="n">list</span><span class="p">(:</span><span class="n">place</span><span class="o">-</span><span class="mi">1</span><span class="p">)]</span>
<a name="ln-5589"></a>   <span class="k">else</span>
<a name="ln-5590"></a><span class="k">      </span><span class="n">list</span><span class="o">=</span><span class="p">[</span> <span class="n">list</span><span class="p">(:</span><span class="n">place</span><span class="o">-</span><span class="mi">1</span><span class="p">),</span> <span class="n">list</span><span class="p">(</span><span class="n">place</span><span class="o">+</span><span class="mi">1</span><span class="p">:)</span> <span class="p">]</span>
<a name="ln-5591"></a>   <span class="k">endif</span>
<a name="ln-5592"></a>
<a name="ln-5593"></a><span class="k">end subroutine </span><span class="n">remove_i</span>
<a name="ln-5594"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-5595"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()=</span>
<a name="ln-5596"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-5597"></a><span class="c">!&gt;</span>
<a name="ln-5598"></a><span class="c">!!##NAME</span>
<a name="ln-5599"></a><span class="c">!!    replace(3f) - [M_CLI2] replace entry in a string array at specified position</span>
<a name="ln-5600"></a><span class="c">!!    (LICENSE:PD)</span>
<a name="ln-5601"></a><span class="c">!!</span>
<a name="ln-5602"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-5603"></a><span class="c">!!</span>
<a name="ln-5604"></a><span class="c">!!   subroutine replace(list,value,place)</span>
<a name="ln-5605"></a><span class="c">!!</span>
<a name="ln-5606"></a><span class="c">!!    character(len=*)|doubleprecision|real|integer,intent(in) :: value</span>
<a name="ln-5607"></a><span class="c">!!    character(len=:)|doubleprecision|real|integer,intent(in) :: list(:)</span>
<a name="ln-5608"></a><span class="c">!!    integer, intent(out)          :: PLACE</span>
<a name="ln-5609"></a><span class="c">!!</span>
<a name="ln-5610"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-5611"></a><span class="c">!!</span>
<a name="ln-5612"></a><span class="c">!!    replace a value in an allocatable array at the specified index. Unless the</span>
<a name="ln-5613"></a><span class="c">!!    array needs the string length to increase this is merely an assign of a value</span>
<a name="ln-5614"></a><span class="c">!!    to an array element.</span>
<a name="ln-5615"></a><span class="c">!!</span>
<a name="ln-5616"></a><span class="c">!!    The array may be of type CHARACTER, DOUBLEPRECISION, REAL, or INTEGER&gt;</span>
<a name="ln-5617"></a><span class="c">!!    It is assumed to be sorted in descending order without duplicate values.</span>
<a name="ln-5618"></a><span class="c">!!</span>
<a name="ln-5619"></a><span class="c">!!    The value and list must be of the same type.</span>
<a name="ln-5620"></a><span class="c">!!</span>
<a name="ln-5621"></a><span class="c">!!##OPTIONS</span>
<a name="ln-5622"></a><span class="c">!!</span>
<a name="ln-5623"></a><span class="c">!!    VALUE         the value to place in the array</span>
<a name="ln-5624"></a><span class="c">!!    LIST          is the array.</span>
<a name="ln-5625"></a><span class="c">!!    PLACE         is the subscript that the entry should be placed at</span>
<a name="ln-5626"></a><span class="c">!!</span>
<a name="ln-5627"></a><span class="c">!!##EXAMPLES</span>
<a name="ln-5628"></a><span class="c">!!</span>
<a name="ln-5629"></a><span class="c">!!</span>
<a name="ln-5630"></a><span class="c">!! Replace key-value pairs in a dictionary</span>
<a name="ln-5631"></a><span class="c">!!</span>
<a name="ln-5632"></a><span class="c">!!     program demo_replace</span>
<a name="ln-5633"></a><span class="c">!!     use M_CLI2, only  : insert, locate, replace</span>
<a name="ln-5634"></a><span class="c">!!     ! Find if a key is in a list and insert it</span>
<a name="ln-5635"></a><span class="c">!!     ! into the key list and value list if it is not present</span>
<a name="ln-5636"></a><span class="c">!!     ! or replace the associated value if the key existed</span>
<a name="ln-5637"></a><span class="c">!!     implicit none</span>
<a name="ln-5638"></a><span class="c">!!     character(len=20)            :: key</span>
<a name="ln-5639"></a><span class="c">!!     character(len=100)           :: val</span>
<a name="ln-5640"></a><span class="c">!!     character(len=:),allocatable :: keywords(:)</span>
<a name="ln-5641"></a><span class="c">!!     character(len=:),allocatable :: values(:)</span>
<a name="ln-5642"></a><span class="c">!!     integer                      :: i</span>
<a name="ln-5643"></a><span class="c">!!     integer                      :: place</span>
<a name="ln-5644"></a><span class="c">!!     call update(&#39;b&#39;,&#39;value of b&#39;)</span>
<a name="ln-5645"></a><span class="c">!!     call update(&#39;a&#39;,&#39;value of a&#39;)</span>
<a name="ln-5646"></a><span class="c">!!     call update(&#39;c&#39;,&#39;value of c&#39;)</span>
<a name="ln-5647"></a><span class="c">!!     call update(&#39;c&#39;,&#39;value of c again&#39;)</span>
<a name="ln-5648"></a><span class="c">!!     call update(&#39;d&#39;,&#39;value of d&#39;)</span>
<a name="ln-5649"></a><span class="c">!!     call update(&#39;a&#39;,&#39;value of a again&#39;)</span>
<a name="ln-5650"></a><span class="c">!!     ! show array</span>
<a name="ln-5651"></a><span class="c">!!     write(*,&#39;(*(a,&quot;==&gt;&quot;,a,/))&#39;)(trim(keywords(i)),trim(values(i)),i=1,size(keywords))</span>
<a name="ln-5652"></a><span class="c">!!</span>
<a name="ln-5653"></a><span class="c">!!     call locate_key(&#39;a&#39;,place)</span>
<a name="ln-5654"></a><span class="c">!!     if(place.gt.0)then</span>
<a name="ln-5655"></a><span class="c">!!        write(*,*)&#39;The value of &quot;a&quot; is&#39;,trim(values(place))</span>
<a name="ln-5656"></a><span class="c">!!     else</span>
<a name="ln-5657"></a><span class="c">!!        write(*,*)&#39;&quot;a&quot; not found&#39;</span>
<a name="ln-5658"></a><span class="c">!!     endif</span>
<a name="ln-5659"></a><span class="c">!!</span>
<a name="ln-5660"></a><span class="c">!!     contains</span>
<a name="ln-5661"></a><span class="c">!!     subroutine update(key,val)</span>
<a name="ln-5662"></a><span class="c">!!     character(len=*),intent(in)  :: key</span>
<a name="ln-5663"></a><span class="c">!!     character(len=*),intent(in)  :: val</span>
<a name="ln-5664"></a><span class="c">!!     integer                      :: place</span>
<a name="ln-5665"></a><span class="c">!!</span>
<a name="ln-5666"></a><span class="c">!!     ! find where string is or should be</span>
<a name="ln-5667"></a><span class="c">!!     call locate_key(key,place)</span>
<a name="ln-5668"></a><span class="c">!!     ! if string was not found insert it</span>
<a name="ln-5669"></a><span class="c">!!     if(place.lt.1)then</span>
<a name="ln-5670"></a><span class="c">!!        call insert(keywords,key,abs(place))</span>
<a name="ln-5671"></a><span class="c">!!        call insert(values,val,abs(place))</span>
<a name="ln-5672"></a><span class="c">!!     else ! replace</span>
<a name="ln-5673"></a><span class="c">!!        call replace(values,val,place)</span>
<a name="ln-5674"></a><span class="c">!!     endif</span>
<a name="ln-5675"></a><span class="c">!!</span>
<a name="ln-5676"></a><span class="c">!!     end subroutine update</span>
<a name="ln-5677"></a><span class="c">!!    end program demo_replace</span>
<a name="ln-5678"></a><span class="c">!!</span>
<a name="ln-5679"></a><span class="c">!!   Expected output</span>
<a name="ln-5680"></a><span class="c">!!</span>
<a name="ln-5681"></a><span class="c">!!    d==&gt;value of d</span>
<a name="ln-5682"></a><span class="c">!!    c==&gt;value of c again</span>
<a name="ln-5683"></a><span class="c">!!    b==&gt;value of b</span>
<a name="ln-5684"></a><span class="c">!!    a==&gt;value of a again</span>
<a name="ln-5685"></a><span class="c">!!</span>
<a name="ln-5686"></a><span class="c">!!##AUTHOR</span>
<a name="ln-5687"></a><span class="c">!!    1989,2017 John S. Urban</span>
<a name="ln-5688"></a><span class="c">!!##LICENSE</span>
<a name="ln-5689"></a><span class="c">!!    Public Domain</span>
<a name="ln-5690"></a><span class="k">subroutine </span><span class="n">replace_c</span><span class="p">(</span><span class="n">list</span><span class="p">,</span><span class="k">value</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-5691"></a>
<a name="ln-5692"></a><span class="c">! ident_33=&quot;@(#)M_CLI2::replace_c(3fp): replace string in allocatable string array at specified position&quot;</span>
<a name="ln-5693"></a>
<a name="ln-5694"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>  <span class="kd">::</span> <span class="k">value</span>
<a name="ln-5695"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">list</span><span class="p">(:)</span>
<a name="ln-5696"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">kludge</span><span class="p">(:)</span>
<a name="ln-5697"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>           <span class="kd">::</span> <span class="n">place</span>
<a name="ln-5698"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">ii</span>
<a name="ln-5699"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">tlen</span>
<a name="ln-5700"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="k">end</span>
<a name="ln-5701"></a><span class="k">   if</span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="nb">allocated</span><span class="p">(</span><span class="n">list</span><span class="p">))</span><span class="k">then</span>
<a name="ln-5702"></a><span class="k">      </span><span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="nb">max</span><span class="p">(</span><span class="nb">len_trim</span><span class="p">(</span><span class="k">value</span><span class="p">),</span><span class="mi">2</span><span class="p">))</span> <span class="kd">::</span> <span class="p">]</span>
<a name="ln-5703"></a>   <span class="k">endif</span>
<a name="ln-5704"></a><span class="k">   </span><span class="n">tlen</span><span class="o">=</span><span class="nb">len_trim</span><span class="p">(</span><span class="k">value</span><span class="p">)</span>
<a name="ln-5705"></a>   <span class="k">end</span><span class="o">=</span><span class="n">size</span><span class="p">(</span><span class="n">list</span><span class="p">)</span>
<a name="ln-5706"></a>   <span class="k">if</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">lt</span><span class="p">.</span><span class="mf">0.</span><span class="nb">or</span><span class="p">.</span><span class="n">place</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="k">end</span><span class="p">)</span><span class="k">then</span>
<a name="ln-5707"></a><span class="k">           write</span><span class="p">(</span><span class="n">warn</span><span class="p">,</span><span class="o">*</span><span class="p">)</span><span class="s1">&#39;*replace_c* error: index out of range. end=&#39;</span><span class="p">,</span><span class="k">end</span><span class="p">,</span><span class="s1">&#39; index=&#39;</span><span class="p">,</span><span class="n">place</span>
<a name="ln-5708"></a>   <span class="n">elseif</span><span class="p">(</span><span class="nb">len_trim</span><span class="p">(</span><span class="k">value</span><span class="p">).</span><span class="n">le</span><span class="p">.</span><span class="nb">len</span><span class="p">(</span><span class="n">list</span><span class="p">))</span><span class="k">then</span>
<a name="ln-5709"></a><span class="k">      </span><span class="n">list</span><span class="p">(</span><span class="n">place</span><span class="p">)</span><span class="o">=</span><span class="k">value</span>
<a name="ln-5710"></a><span class="k">   else</span>  <span class="c">! increase length of variable</span>
<a name="ln-5711"></a>      <span class="n">ii</span><span class="o">=</span><span class="nb">max</span><span class="p">(</span><span class="n">tlen</span><span class="p">,</span><span class="nb">len</span><span class="p">(</span><span class="n">list</span><span class="p">))</span>
<a name="ln-5712"></a>      <span class="n">kludge</span><span class="o">=</span><span class="p">[</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="n">ii</span><span class="p">)</span> <span class="kd">::</span> <span class="n">list</span> <span class="p">]</span>
<a name="ln-5713"></a>      <span class="n">list</span><span class="o">=</span><span class="n">kludge</span>
<a name="ln-5714"></a>      <span class="n">list</span><span class="p">(</span><span class="n">place</span><span class="p">)</span><span class="o">=</span><span class="k">value</span>
<a name="ln-5715"></a><span class="k">   endif</span>
<a name="ln-5716"></a><span class="k">end subroutine </span><span class="n">replace_c</span>
<a name="ln-5717"></a><span class="k">subroutine </span><span class="n">replace_l</span><span class="p">(</span><span class="n">list</span><span class="p">,</span><span class="k">value</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-5718"></a>
<a name="ln-5719"></a><span class="c">! ident_34=&quot;@(#)M_CLI2::replace_l(3fp): place value into allocatable array at specified position&quot;</span>
<a name="ln-5720"></a>
<a name="ln-5721"></a><span class="kt">logical</span><span class="p">,</span><span class="k">allocatable</span>   <span class="kd">::</span> <span class="n">list</span><span class="p">(:)</span>
<a name="ln-5722"></a><span class="kt">logical</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>    <span class="kd">::</span> <span class="k">value</span>
<a name="ln-5723"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>    <span class="kd">::</span> <span class="n">place</span>
<a name="ln-5724"></a><span class="kt">integer</span>               <span class="kd">::</span> <span class="k">end</span>
<a name="ln-5725"></a><span class="k">   if</span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="nb">allocated</span><span class="p">(</span><span class="n">list</span><span class="p">))</span><span class="k">then</span>
<a name="ln-5726"></a><span class="k">      </span><span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="kt">logical</span> <span class="kd">::</span> <span class="p">]</span>
<a name="ln-5727"></a>   <span class="k">endif</span>
<a name="ln-5728"></a><span class="k">   end</span><span class="o">=</span><span class="n">size</span><span class="p">(</span><span class="n">list</span><span class="p">)</span>
<a name="ln-5729"></a>   <span class="k">if</span><span class="p">(</span><span class="k">end</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                          <span class="c">! empty array</span>
<a name="ln-5730"></a>      <span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="k">value</span><span class="p">]</span>
<a name="ln-5731"></a>   <span class="n">elseif</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="mf">0.</span><span class="nb">and</span><span class="p">.</span><span class="n">place</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="k">end</span><span class="p">)</span><span class="k">then</span>
<a name="ln-5732"></a><span class="k">      </span><span class="n">list</span><span class="p">(</span><span class="n">place</span><span class="p">)</span><span class="o">=</span><span class="k">value</span>
<a name="ln-5733"></a><span class="k">   else</span>                                                      <span class="c">! put in middle of array</span>
<a name="ln-5734"></a>      <span class="k">write</span><span class="p">(</span><span class="n">warn</span><span class="p">,</span><span class="o">*</span><span class="p">)</span><span class="s1">&#39;*replace_l* error: index out of range. end=&#39;</span><span class="p">,</span><span class="k">end</span><span class="p">,</span><span class="s1">&#39; index=&#39;</span><span class="p">,</span><span class="n">place</span>
<a name="ln-5735"></a>   <span class="k">endif</span>
<a name="ln-5736"></a><span class="k">end subroutine </span><span class="n">replace_l</span>
<a name="ln-5737"></a><span class="k">subroutine </span><span class="n">replace_i</span><span class="p">(</span><span class="n">list</span><span class="p">,</span><span class="k">value</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-5738"></a>
<a name="ln-5739"></a><span class="c">! ident_35=&quot;@(#)M_CLI2::replace_i(3fp): place value into allocatable array at specified position&quot;</span>
<a name="ln-5740"></a>
<a name="ln-5741"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>    <span class="kd">::</span> <span class="k">value</span>
<a name="ln-5742"></a><span class="kt">integer</span><span class="p">,</span><span class="k">allocatable</span>   <span class="kd">::</span> <span class="n">list</span><span class="p">(:)</span>
<a name="ln-5743"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>    <span class="kd">::</span> <span class="n">place</span>
<a name="ln-5744"></a><span class="kt">integer</span>               <span class="kd">::</span> <span class="k">end</span>
<a name="ln-5745"></a><span class="k">   if</span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="nb">allocated</span><span class="p">(</span><span class="n">list</span><span class="p">))</span><span class="k">then</span>
<a name="ln-5746"></a><span class="k">      </span><span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="kt">integer</span> <span class="kd">::</span> <span class="p">]</span>
<a name="ln-5747"></a>   <span class="k">endif</span>
<a name="ln-5748"></a><span class="k">   end</span><span class="o">=</span><span class="n">size</span><span class="p">(</span><span class="n">list</span><span class="p">)</span>
<a name="ln-5749"></a>   <span class="k">if</span><span class="p">(</span><span class="k">end</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                          <span class="c">! empty array</span>
<a name="ln-5750"></a>      <span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="k">value</span><span class="p">]</span>
<a name="ln-5751"></a>   <span class="n">elseif</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="mf">0.</span><span class="nb">and</span><span class="p">.</span><span class="n">place</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="k">end</span><span class="p">)</span><span class="k">then</span>
<a name="ln-5752"></a><span class="k">      </span><span class="n">list</span><span class="p">(</span><span class="n">place</span><span class="p">)</span><span class="o">=</span><span class="k">value</span>
<a name="ln-5753"></a><span class="k">   else</span>                                                      <span class="c">! put in middle of array</span>
<a name="ln-5754"></a>      <span class="k">write</span><span class="p">(</span><span class="n">warn</span><span class="p">,</span><span class="o">*</span><span class="p">)</span><span class="s1">&#39;*replace_i* error: index out of range. end=&#39;</span><span class="p">,</span><span class="k">end</span><span class="p">,</span><span class="s1">&#39; index=&#39;</span><span class="p">,</span><span class="n">place</span>
<a name="ln-5755"></a>   <span class="k">endif</span>
<a name="ln-5756"></a><span class="k">end subroutine </span><span class="n">replace_i</span>
<a name="ln-5757"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-5758"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()=</span>
<a name="ln-5759"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-5760"></a><span class="c">!&gt;</span>
<a name="ln-5761"></a><span class="c">!!##NAME</span>
<a name="ln-5762"></a><span class="c">!!    insert(3f) - [M_CLI2] insert entry into a string array at specified position</span>
<a name="ln-5763"></a><span class="c">!!    (LICENSE:PD)</span>
<a name="ln-5764"></a><span class="c">!!</span>
<a name="ln-5765"></a><span class="c">!!##SYNOPSIS</span>
<a name="ln-5766"></a><span class="c">!!</span>
<a name="ln-5767"></a><span class="c">!!   subroutine insert(list,value,place)</span>
<a name="ln-5768"></a><span class="c">!!</span>
<a name="ln-5769"></a><span class="c">!!    character(len=*)|doubleprecision|real|integer,intent(in) :: value</span>
<a name="ln-5770"></a><span class="c">!!    character(len=:)|doubleprecision|real|integer,intent(in) :: list(:)</span>
<a name="ln-5771"></a><span class="c">!!    integer,intent(in)    :: place</span>
<a name="ln-5772"></a><span class="c">!!</span>
<a name="ln-5773"></a><span class="c">!!##DESCRIPTION</span>
<a name="ln-5774"></a><span class="c">!!</span>
<a name="ln-5775"></a><span class="c">!!    Insert a value into an allocatable array at the specified index.</span>
<a name="ln-5776"></a><span class="c">!!    The list and value must be of the same type (CHARACTER, DOUBLEPRECISION,</span>
<a name="ln-5777"></a><span class="c">!!    REAL, or INTEGER)</span>
<a name="ln-5778"></a><span class="c">!!</span>
<a name="ln-5779"></a><span class="c">!!##OPTIONS</span>
<a name="ln-5780"></a><span class="c">!!</span>
<a name="ln-5781"></a><span class="c">!!    list    is the list array. Must be sorted in descending order.</span>
<a name="ln-5782"></a><span class="c">!!    value   the value to place in the array</span>
<a name="ln-5783"></a><span class="c">!!    PLACE   is the subscript that the entry should be placed at</span>
<a name="ln-5784"></a><span class="c">!!</span>
<a name="ln-5785"></a><span class="c">!!##EXAMPLES</span>
<a name="ln-5786"></a><span class="c">!!</span>
<a name="ln-5787"></a><span class="c">!!</span>
<a name="ln-5788"></a><span class="c">!! Find if a string is in a sorted array, and insert the string into</span>
<a name="ln-5789"></a><span class="c">!! the list if it is not present ...</span>
<a name="ln-5790"></a><span class="c">!!</span>
<a name="ln-5791"></a><span class="c">!!     program demo_insert</span>
<a name="ln-5792"></a><span class="c">!!     use M_sort, only : sort_shell</span>
<a name="ln-5793"></a><span class="c">!!     use M_CLI2, only : locate, insert</span>
<a name="ln-5794"></a><span class="c">!!     implicit none</span>
<a name="ln-5795"></a><span class="c">!!     character(len=:),allocatable :: arr(:)</span>
<a name="ln-5796"></a><span class="c">!!     integer                       :: i</span>
<a name="ln-5797"></a><span class="c">!!</span>
<a name="ln-5798"></a><span class="c">!!     arr=[character(len=20) :: &#39;&#39;, &#39;ZZZ&#39;, &#39;aaa&#39;, &#39;b&#39;, &#39;xxx&#39; ]</span>
<a name="ln-5799"></a><span class="c">!!     ! make sure sorted in descending order</span>
<a name="ln-5800"></a><span class="c">!!     call sort_shell(arr,order=&#39;d&#39;)</span>
<a name="ln-5801"></a><span class="c">!!     ! add or replace values</span>
<a name="ln-5802"></a><span class="c">!!     call update(arr,&#39;b&#39;)</span>
<a name="ln-5803"></a><span class="c">!!     call update(arr,&#39;[&#39;)</span>
<a name="ln-5804"></a><span class="c">!!     call update(arr,&#39;c&#39;)</span>
<a name="ln-5805"></a><span class="c">!!     call update(arr,&#39;ZZ&#39;)</span>
<a name="ln-5806"></a><span class="c">!!     call update(arr,&#39;ZZZ&#39;)</span>
<a name="ln-5807"></a><span class="c">!!     call update(arr,&#39;ZZZZ&#39;)</span>
<a name="ln-5808"></a><span class="c">!!     call update(arr,&#39;&#39;)</span>
<a name="ln-5809"></a><span class="c">!!     call update(arr,&#39;z&#39;)</span>
<a name="ln-5810"></a><span class="c">!!</span>
<a name="ln-5811"></a><span class="c">!!     contains</span>
<a name="ln-5812"></a><span class="c">!!     subroutine update(arr,string)</span>
<a name="ln-5813"></a><span class="c">!!     character(len=:),allocatable :: arr(:)</span>
<a name="ln-5814"></a><span class="c">!!     character(len=*)             :: string</span>
<a name="ln-5815"></a><span class="c">!!     integer                      :: place, end</span>
<a name="ln-5816"></a><span class="c">!!</span>
<a name="ln-5817"></a><span class="c">!!     end=size(arr)</span>
<a name="ln-5818"></a><span class="c">!!     ! find where string is or should be</span>
<a name="ln-5819"></a><span class="c">!!     call locate(arr,string,place)</span>
<a name="ln-5820"></a><span class="c">!!     ! if string was not found insert it</span>
<a name="ln-5821"></a><span class="c">!!     if(place.lt.1)then</span>
<a name="ln-5822"></a><span class="c">!!        call insert(arr,string,abs(place))</span>
<a name="ln-5823"></a><span class="c">!!     endif</span>
<a name="ln-5824"></a><span class="c">!!     ! show array</span>
<a name="ln-5825"></a><span class="c">!!     end=size(arr)</span>
<a name="ln-5826"></a><span class="c">!!     write(*,&#39;(&quot;array is now SIZE=&quot;,i0,1x,*(a,&quot;,&quot;))&#39;)end,(trim(arr(i)),i=1,end)</span>
<a name="ln-5827"></a><span class="c">!!</span>
<a name="ln-5828"></a><span class="c">!!     end subroutine update</span>
<a name="ln-5829"></a><span class="c">!!     end program demo_insert</span>
<a name="ln-5830"></a><span class="c">!!</span>
<a name="ln-5831"></a><span class="c">!!   Results:</span>
<a name="ln-5832"></a><span class="c">!!</span>
<a name="ln-5833"></a><span class="c">!!     array is now SIZE=5 xxx,b,aaa,ZZZ,,</span>
<a name="ln-5834"></a><span class="c">!!     array is now SIZE=6 xxx,b,aaa,[,ZZZ,,</span>
<a name="ln-5835"></a><span class="c">!!     array is now SIZE=7 xxx,c,b,aaa,[,ZZZ,,</span>
<a name="ln-5836"></a><span class="c">!!     array is now SIZE=8 xxx,c,b,aaa,[,ZZZ,ZZ,,</span>
<a name="ln-5837"></a><span class="c">!!     array is now SIZE=9 xxx,c,b,aaa,[,ZZZZ,ZZZ,ZZ,,</span>
<a name="ln-5838"></a><span class="c">!!     array is now SIZE=10 z,xxx,c,b,aaa,[,ZZZZ,ZZZ,ZZ,,</span>
<a name="ln-5839"></a><span class="c">!!</span>
<a name="ln-5840"></a><span class="c">!!##AUTHOR</span>
<a name="ln-5841"></a><span class="c">!!    1989,2017 John S. Urban</span>
<a name="ln-5842"></a><span class="c">!!##LICENSE</span>
<a name="ln-5843"></a><span class="c">!!    Public Domain</span>
<a name="ln-5844"></a><span class="k">subroutine </span><span class="n">insert_c</span><span class="p">(</span><span class="n">list</span><span class="p">,</span><span class="k">value</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-5845"></a>
<a name="ln-5846"></a><span class="c">! ident_36=&quot;@(#)M_CLI2::insert_c(3fp): place string into allocatable string array at specified position&quot;</span>
<a name="ln-5847"></a>
<a name="ln-5848"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>  <span class="kd">::</span> <span class="k">value</span>
<a name="ln-5849"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">list</span><span class="p">(:)</span>
<a name="ln-5850"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">kludge</span><span class="p">(:)</span>
<a name="ln-5851"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>           <span class="kd">::</span> <span class="n">place</span>
<a name="ln-5852"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">ii</span>
<a name="ln-5853"></a><span class="kt">integer</span>                      <span class="kd">::</span> <span class="k">end</span>
<a name="ln-5854"></a>
<a name="ln-5855"></a><span class="k">   if</span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="nb">allocated</span><span class="p">(</span><span class="n">list</span><span class="p">))</span><span class="k">then</span>
<a name="ln-5856"></a><span class="k">      </span><span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="nb">max</span><span class="p">(</span><span class="nb">len_trim</span><span class="p">(</span><span class="k">value</span><span class="p">),</span><span class="mi">2</span><span class="p">))</span> <span class="kd">::</span> <span class="p">]</span>
<a name="ln-5857"></a>   <span class="k">endif</span>
<a name="ln-5858"></a>
<a name="ln-5859"></a><span class="k">   </span><span class="n">ii</span><span class="o">=</span><span class="nb">max</span><span class="p">(</span><span class="nb">len_trim</span><span class="p">(</span><span class="k">value</span><span class="p">),</span><span class="nb">len</span><span class="p">(</span><span class="n">list</span><span class="p">),</span><span class="mi">2</span><span class="p">)</span>
<a name="ln-5860"></a>   <span class="k">end</span><span class="o">=</span><span class="n">size</span><span class="p">(</span><span class="n">list</span><span class="p">)</span>
<a name="ln-5861"></a>
<a name="ln-5862"></a>   <span class="k">if</span><span class="p">(</span><span class="k">end</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                          <span class="c">! empty array</span>
<a name="ln-5863"></a>      <span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="n">ii</span><span class="p">)</span> <span class="kd">::</span> <span class="k">value</span> <span class="p">]</span>
<a name="ln-5864"></a>   <span class="n">elseif</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="mi">1</span><span class="p">)</span><span class="k">then</span>                                    <span class="c">! put in front of array</span>
<a name="ln-5865"></a>      <span class="n">kludge</span><span class="o">=</span><span class="p">[</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="n">ii</span><span class="p">)</span> <span class="kd">::</span> <span class="k">value</span><span class="p">,</span> <span class="n">list</span><span class="p">]</span>
<a name="ln-5866"></a>      <span class="n">list</span><span class="o">=</span><span class="n">kludge</span>
<a name="ln-5867"></a>   <span class="n">elseif</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="k">end</span><span class="p">)</span><span class="k">then</span>                                  <span class="c">! put at end of array</span>
<a name="ln-5868"></a>      <span class="n">kludge</span><span class="o">=</span><span class="p">[</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="n">ii</span><span class="p">)</span> <span class="kd">::</span> <span class="n">list</span><span class="p">,</span> <span class="k">value</span> <span class="p">]</span>
<a name="ln-5869"></a>      <span class="n">list</span><span class="o">=</span><span class="n">kludge</span>
<a name="ln-5870"></a>   <span class="n">elseif</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">ge</span><span class="p">.</span><span class="mf">2.</span><span class="nb">and</span><span class="p">.</span><span class="n">place</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="k">end</span><span class="p">)</span><span class="k">then</span>                 <span class="c">! put in middle of array</span>
<a name="ln-5871"></a>      <span class="n">kludge</span><span class="o">=</span><span class="p">[</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="n">ii</span><span class="p">)</span> <span class="kd">::</span> <span class="n">list</span><span class="p">(:</span><span class="n">place</span><span class="o">-</span><span class="mi">1</span><span class="p">),</span> <span class="k">value</span><span class="p">,</span><span class="n">list</span><span class="p">(</span><span class="n">place</span><span class="p">:)</span> <span class="p">]</span>
<a name="ln-5872"></a>      <span class="n">list</span><span class="o">=</span><span class="n">kludge</span>
<a name="ln-5873"></a>   <span class="k">else</span>                                                      <span class="c">! index out of range</span>
<a name="ln-5874"></a>      <span class="k">write</span><span class="p">(</span><span class="n">warn</span><span class="p">,</span><span class="o">*</span><span class="p">)</span><span class="s1">&#39;*insert_c* error: index out of range. end=&#39;</span><span class="p">,</span><span class="k">end</span><span class="p">,</span><span class="s1">&#39; index=&#39;</span><span class="p">,</span><span class="n">place</span><span class="p">,</span><span class="s1">&#39; value=&#39;</span><span class="p">,</span><span class="k">value</span>
<a name="ln-5875"></a><span class="k">   endif</span>
<a name="ln-5876"></a>
<a name="ln-5877"></a><span class="k">end subroutine </span><span class="n">insert_c</span>
<a name="ln-5878"></a><span class="k">subroutine </span><span class="n">insert_l</span><span class="p">(</span><span class="n">list</span><span class="p">,</span><span class="k">value</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-5879"></a>
<a name="ln-5880"></a><span class="c">! ident_37=&quot;@(#)M_CLI2::insert_l(3fp): place value into allocatable array at specified position&quot;</span>
<a name="ln-5881"></a>
<a name="ln-5882"></a><span class="kt">logical</span><span class="p">,</span><span class="k">allocatable</span>   <span class="kd">::</span> <span class="n">list</span><span class="p">(:)</span>
<a name="ln-5883"></a><span class="kt">logical</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>    <span class="kd">::</span> <span class="k">value</span>
<a name="ln-5884"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>    <span class="kd">::</span> <span class="n">place</span>
<a name="ln-5885"></a><span class="kt">integer</span>               <span class="kd">::</span> <span class="k">end</span>
<a name="ln-5886"></a><span class="k">   if</span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="nb">allocated</span><span class="p">(</span><span class="n">list</span><span class="p">))</span><span class="k">then</span>
<a name="ln-5887"></a><span class="k">      </span><span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="kt">logical</span> <span class="kd">::</span> <span class="p">]</span>
<a name="ln-5888"></a>   <span class="k">endif</span>
<a name="ln-5889"></a><span class="k">   end</span><span class="o">=</span><span class="n">size</span><span class="p">(</span><span class="n">list</span><span class="p">)</span>
<a name="ln-5890"></a>   <span class="k">if</span><span class="p">(</span><span class="k">end</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                          <span class="c">! empty array</span>
<a name="ln-5891"></a>      <span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="k">value</span><span class="p">]</span>
<a name="ln-5892"></a>   <span class="n">elseif</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="mi">1</span><span class="p">)</span><span class="k">then</span>                                    <span class="c">! put in front of array</span>
<a name="ln-5893"></a>      <span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="k">value</span><span class="p">,</span> <span class="n">list</span><span class="p">]</span>
<a name="ln-5894"></a>   <span class="n">elseif</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="k">end</span><span class="p">)</span><span class="k">then</span>                                  <span class="c">! put at end of array</span>
<a name="ln-5895"></a>      <span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="n">list</span><span class="p">,</span> <span class="k">value</span> <span class="p">]</span>
<a name="ln-5896"></a>   <span class="n">elseif</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">ge</span><span class="p">.</span><span class="mf">2.</span><span class="nb">and</span><span class="p">.</span><span class="n">place</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="k">end</span><span class="p">)</span><span class="k">then</span>                 <span class="c">! put in middle of array</span>
<a name="ln-5897"></a>      <span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="n">list</span><span class="p">(:</span><span class="n">place</span><span class="o">-</span><span class="mi">1</span><span class="p">),</span> <span class="k">value</span><span class="p">,</span><span class="n">list</span><span class="p">(</span><span class="n">place</span><span class="p">:)</span> <span class="p">]</span>
<a name="ln-5898"></a>   <span class="k">else</span>                                                      <span class="c">! index out of range</span>
<a name="ln-5899"></a>      <span class="k">write</span><span class="p">(</span><span class="n">warn</span><span class="p">,</span><span class="o">*</span><span class="p">)</span><span class="s1">&#39;*insert_l* error: index out of range. end=&#39;</span><span class="p">,</span><span class="k">end</span><span class="p">,</span><span class="s1">&#39; index=&#39;</span><span class="p">,</span><span class="n">place</span><span class="p">,</span><span class="s1">&#39; value=&#39;</span><span class="p">,</span><span class="k">value</span>
<a name="ln-5900"></a><span class="k">   endif</span>
<a name="ln-5901"></a>
<a name="ln-5902"></a><span class="k">end subroutine </span><span class="n">insert_l</span>
<a name="ln-5903"></a><span class="k">subroutine </span><span class="n">insert_i</span><span class="p">(</span><span class="n">list</span><span class="p">,</span><span class="k">value</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-5904"></a>
<a name="ln-5905"></a><span class="c">! ident_38=&quot;@(#)M_CLI2::insert_i(3fp): place value into allocatable array at specified position&quot;</span>
<a name="ln-5906"></a>
<a name="ln-5907"></a><span class="kt">integer</span><span class="p">,</span><span class="k">allocatable</span>   <span class="kd">::</span> <span class="n">list</span><span class="p">(:)</span>
<a name="ln-5908"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>    <span class="kd">::</span> <span class="k">value</span>
<a name="ln-5909"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>    <span class="kd">::</span> <span class="n">place</span>
<a name="ln-5910"></a><span class="kt">integer</span>               <span class="kd">::</span> <span class="k">end</span>
<a name="ln-5911"></a><span class="k">   if</span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="nb">allocated</span><span class="p">(</span><span class="n">list</span><span class="p">))</span><span class="k">then</span>
<a name="ln-5912"></a><span class="k">      </span><span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="kt">integer</span> <span class="kd">::</span> <span class="p">]</span>
<a name="ln-5913"></a>   <span class="k">endif</span>
<a name="ln-5914"></a><span class="k">   end</span><span class="o">=</span><span class="n">size</span><span class="p">(</span><span class="n">list</span><span class="p">)</span>
<a name="ln-5915"></a>   <span class="k">if</span><span class="p">(</span><span class="k">end</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>                                          <span class="c">! empty array</span>
<a name="ln-5916"></a>      <span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="k">value</span><span class="p">]</span>
<a name="ln-5917"></a>   <span class="n">elseif</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="mi">1</span><span class="p">)</span><span class="k">then</span>                                    <span class="c">! put in front of array</span>
<a name="ln-5918"></a>      <span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="k">value</span><span class="p">,</span> <span class="n">list</span><span class="p">]</span>
<a name="ln-5919"></a>   <span class="n">elseif</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="k">end</span><span class="p">)</span><span class="k">then</span>                                  <span class="c">! put at end of array</span>
<a name="ln-5920"></a>      <span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="n">list</span><span class="p">,</span> <span class="k">value</span> <span class="p">]</span>
<a name="ln-5921"></a>   <span class="n">elseif</span><span class="p">(</span><span class="n">place</span><span class="p">.</span><span class="n">ge</span><span class="p">.</span><span class="mf">2.</span><span class="nb">and</span><span class="p">.</span><span class="n">place</span><span class="p">.</span><span class="n">le</span><span class="p">.</span><span class="k">end</span><span class="p">)</span><span class="k">then</span>                 <span class="c">! put in middle of array</span>
<a name="ln-5922"></a>      <span class="n">list</span><span class="o">=</span><span class="p">[</span><span class="n">list</span><span class="p">(:</span><span class="n">place</span><span class="o">-</span><span class="mi">1</span><span class="p">),</span> <span class="k">value</span><span class="p">,</span><span class="n">list</span><span class="p">(</span><span class="n">place</span><span class="p">:)</span> <span class="p">]</span>
<a name="ln-5923"></a>   <span class="k">else</span>                                                      <span class="c">! index out of range</span>
<a name="ln-5924"></a>      <span class="k">write</span><span class="p">(</span><span class="n">warn</span><span class="p">,</span><span class="o">*</span><span class="p">)</span><span class="s1">&#39;*insert_i* error: index out of range. end=&#39;</span><span class="p">,</span><span class="k">end</span><span class="p">,</span><span class="s1">&#39; index=&#39;</span><span class="p">,</span><span class="n">place</span><span class="p">,</span><span class="s1">&#39; value=&#39;</span><span class="p">,</span><span class="k">value</span>
<a name="ln-5925"></a><span class="k">   endif</span>
<a name="ln-5926"></a>
<a name="ln-5927"></a><span class="k">end subroutine </span><span class="n">insert_i</span>
<a name="ln-5928"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-5929"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()=</span>
<a name="ln-5930"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-5931"></a><span class="k">subroutine </span><span class="n">many_args</span><span class="p">(</span><span class="n">n0</span><span class="p">,</span><span class="n">g0</span><span class="p">,</span> <span class="n">n1</span><span class="p">,</span><span class="n">g1</span><span class="p">,</span> <span class="n">n2</span><span class="p">,</span><span class="n">g2</span><span class="p">,</span> <span class="n">n3</span><span class="p">,</span><span class="n">g3</span><span class="p">,</span> <span class="n">n4</span><span class="p">,</span><span class="n">g4</span><span class="p">,</span> <span class="n">n5</span><span class="p">,</span><span class="n">g5</span><span class="p">,</span> <span class="n">n6</span><span class="p">,</span><span class="n">g6</span><span class="p">,</span> <span class="n">n7</span><span class="p">,</span><span class="n">g7</span><span class="p">,</span> <span class="n">n8</span><span class="p">,</span><span class="n">g8</span><span class="p">,</span> <span class="n">n9</span><span class="p">,</span><span class="n">g9</span><span class="p">,</span> <span class="p">&amp;</span>
<a name="ln-5932"></a>                   <span class="p">&amp;</span> <span class="n">na</span><span class="p">,</span><span class="n">ga</span><span class="p">,</span> <span class="n">nb</span><span class="p">,</span><span class="n">gb</span><span class="p">,</span> <span class="n">nc</span><span class="p">,</span><span class="n">gc</span><span class="p">,</span> <span class="n">nd</span><span class="p">,</span><span class="n">gd</span><span class="p">,</span> <span class="n">ne</span><span class="p">,</span><span class="n">ge</span><span class="p">,</span> <span class="n">nf</span><span class="p">,</span><span class="n">gf</span><span class="p">,</span> <span class="n">ng</span><span class="p">,</span><span class="n">gg</span><span class="p">,</span> <span class="n">nh</span><span class="p">,</span><span class="n">gh</span><span class="p">,</span> <span class="n">ni</span><span class="p">,</span><span class="n">gi</span><span class="p">,</span> <span class="n">nj</span><span class="p">,</span><span class="n">gj</span> <span class="p">)</span>
<a name="ln-5933"></a><span class="k">implicit none</span>
<a name="ln-5934"></a>
<a name="ln-5935"></a><span class="c">! ident_39=&quot;@(#)M_CLI2::many_args(3fp): allow for multiple calls to get_args(3f)&quot;</span>
<a name="ln-5936"></a>
<a name="ln-5937"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">n0</span><span class="p">,</span> <span class="n">n1</span>
<a name="ln-5938"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span>         <span class="n">n2</span><span class="p">,</span> <span class="n">n3</span><span class="p">,</span> <span class="n">n4</span><span class="p">,</span> <span class="n">n5</span><span class="p">,</span> <span class="n">n6</span><span class="p">,</span> <span class="n">n7</span><span class="p">,</span> <span class="n">n8</span><span class="p">,</span> <span class="n">n9</span><span class="p">,</span> <span class="n">na</span><span class="p">,</span> <span class="n">nb</span><span class="p">,</span> <span class="n">nc</span><span class="p">,</span> <span class="n">nd</span><span class="p">,</span> <span class="n">ne</span><span class="p">,</span> <span class="n">nf</span><span class="p">,</span> <span class="n">ng</span><span class="p">,</span> <span class="n">nh</span><span class="p">,</span> <span class="n">ni</span><span class="p">,</span> <span class="n">nj</span>
<a name="ln-5939"></a><span class="k">class</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span>           <span class="kd">::</span> <span class="n">g0</span><span class="p">,</span> <span class="n">g1</span>
<a name="ln-5940"></a><span class="k">class</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">),</span><span class="k">optional</span>  <span class="kd">::</span>         <span class="n">g2</span><span class="p">,</span> <span class="n">g3</span><span class="p">,</span> <span class="n">g4</span><span class="p">,</span> <span class="n">g5</span><span class="p">,</span> <span class="n">g6</span><span class="p">,</span> <span class="n">g7</span><span class="p">,</span> <span class="n">g8</span><span class="p">,</span> <span class="n">g9</span>
<a name="ln-5941"></a><span class="k">class</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">),</span><span class="k">optional</span>  <span class="kd">::</span> <span class="n">ga</span><span class="p">,</span> <span class="n">gb</span><span class="p">,</span> <span class="n">gc</span><span class="p">,</span> <span class="n">gd</span><span class="p">,</span> <span class="n">ge</span><span class="p">,</span> <span class="n">gf</span><span class="p">,</span> <span class="n">gg</span><span class="p">,</span> <span class="n">gh</span><span class="p">,</span> <span class="n">gi</span><span class="p">,</span> <span class="n">gj</span>
<a name="ln-5942"></a>   <span class="k">call </span><span class="n">get_generic</span><span class="p">(</span><span class="n">n0</span><span class="p">,</span><span class="n">g0</span><span class="p">)</span>
<a name="ln-5943"></a>   <span class="k">call </span><span class="n">get_generic</span><span class="p">(</span><span class="n">n1</span><span class="p">,</span><span class="n">g1</span><span class="p">)</span>
<a name="ln-5944"></a>   <span class="k">if</span><span class="p">(</span> <span class="nb">present</span><span class="p">(</span><span class="n">n2</span><span class="p">)</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="nb">present</span><span class="p">(</span><span class="n">g2</span><span class="p">)</span> <span class="p">)</span><span class="k">call </span><span class="n">get_generic</span><span class="p">(</span><span class="n">n2</span><span class="p">,</span><span class="n">g2</span><span class="p">)</span>
<a name="ln-5945"></a>   <span class="k">if</span><span class="p">(</span> <span class="nb">present</span><span class="p">(</span><span class="n">n3</span><span class="p">)</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="nb">present</span><span class="p">(</span><span class="n">g3</span><span class="p">)</span> <span class="p">)</span><span class="k">call </span><span class="n">get_generic</span><span class="p">(</span><span class="n">n3</span><span class="p">,</span><span class="n">g3</span><span class="p">)</span>
<a name="ln-5946"></a>   <span class="k">if</span><span class="p">(</span> <span class="nb">present</span><span class="p">(</span><span class="n">n4</span><span class="p">)</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="nb">present</span><span class="p">(</span><span class="n">g4</span><span class="p">)</span> <span class="p">)</span><span class="k">call </span><span class="n">get_generic</span><span class="p">(</span><span class="n">n4</span><span class="p">,</span><span class="n">g4</span><span class="p">)</span>
<a name="ln-5947"></a>   <span class="k">if</span><span class="p">(</span> <span class="nb">present</span><span class="p">(</span><span class="n">n5</span><span class="p">)</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="nb">present</span><span class="p">(</span><span class="n">g5</span><span class="p">)</span> <span class="p">)</span><span class="k">call </span><span class="n">get_generic</span><span class="p">(</span><span class="n">n5</span><span class="p">,</span><span class="n">g5</span><span class="p">)</span>
<a name="ln-5948"></a>   <span class="k">if</span><span class="p">(</span> <span class="nb">present</span><span class="p">(</span><span class="n">n6</span><span class="p">)</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="nb">present</span><span class="p">(</span><span class="n">g6</span><span class="p">)</span> <span class="p">)</span><span class="k">call </span><span class="n">get_generic</span><span class="p">(</span><span class="n">n6</span><span class="p">,</span><span class="n">g6</span><span class="p">)</span>
<a name="ln-5949"></a>   <span class="k">if</span><span class="p">(</span> <span class="nb">present</span><span class="p">(</span><span class="n">n7</span><span class="p">)</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="nb">present</span><span class="p">(</span><span class="n">g7</span><span class="p">)</span> <span class="p">)</span><span class="k">call </span><span class="n">get_generic</span><span class="p">(</span><span class="n">n7</span><span class="p">,</span><span class="n">g7</span><span class="p">)</span>
<a name="ln-5950"></a>   <span class="k">if</span><span class="p">(</span> <span class="nb">present</span><span class="p">(</span><span class="n">n8</span><span class="p">)</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="nb">present</span><span class="p">(</span><span class="n">g8</span><span class="p">)</span> <span class="p">)</span><span class="k">call </span><span class="n">get_generic</span><span class="p">(</span><span class="n">n8</span><span class="p">,</span><span class="n">g8</span><span class="p">)</span>
<a name="ln-5951"></a>   <span class="k">if</span><span class="p">(</span> <span class="nb">present</span><span class="p">(</span><span class="n">n9</span><span class="p">)</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="nb">present</span><span class="p">(</span><span class="n">g9</span><span class="p">)</span> <span class="p">)</span><span class="k">call </span><span class="n">get_generic</span><span class="p">(</span><span class="n">n9</span><span class="p">,</span><span class="n">g9</span><span class="p">)</span>
<a name="ln-5952"></a>   <span class="k">if</span><span class="p">(</span> <span class="nb">present</span><span class="p">(</span><span class="n">na</span><span class="p">)</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="nb">present</span><span class="p">(</span><span class="n">ga</span><span class="p">)</span> <span class="p">)</span><span class="k">call </span><span class="n">get_generic</span><span class="p">(</span><span class="n">na</span><span class="p">,</span><span class="n">ga</span><span class="p">)</span>
<a name="ln-5953"></a>   <span class="k">if</span><span class="p">(</span> <span class="nb">present</span><span class="p">(</span><span class="n">nb</span><span class="p">)</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="nb">present</span><span class="p">(</span><span class="n">gb</span><span class="p">)</span> <span class="p">)</span><span class="k">call </span><span class="n">get_generic</span><span class="p">(</span><span class="n">nb</span><span class="p">,</span><span class="n">gb</span><span class="p">)</span>
<a name="ln-5954"></a>   <span class="k">if</span><span class="p">(</span> <span class="nb">present</span><span class="p">(</span><span class="n">nc</span><span class="p">)</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="nb">present</span><span class="p">(</span><span class="n">gc</span><span class="p">)</span> <span class="p">)</span><span class="k">call </span><span class="n">get_generic</span><span class="p">(</span><span class="n">nc</span><span class="p">,</span><span class="n">gc</span><span class="p">)</span>
<a name="ln-5955"></a>   <span class="k">if</span><span class="p">(</span> <span class="nb">present</span><span class="p">(</span><span class="n">nd</span><span class="p">)</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="nb">present</span><span class="p">(</span><span class="n">gd</span><span class="p">)</span> <span class="p">)</span><span class="k">call </span><span class="n">get_generic</span><span class="p">(</span><span class="n">nd</span><span class="p">,</span><span class="n">gd</span><span class="p">)</span>
<a name="ln-5956"></a>   <span class="k">if</span><span class="p">(</span> <span class="nb">present</span><span class="p">(</span><span class="n">ne</span><span class="p">)</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="nb">present</span><span class="p">(</span><span class="n">ge</span><span class="p">)</span> <span class="p">)</span><span class="k">call </span><span class="n">get_generic</span><span class="p">(</span><span class="n">ne</span><span class="p">,</span><span class="n">ge</span><span class="p">)</span>
<a name="ln-5957"></a>   <span class="k">if</span><span class="p">(</span> <span class="nb">present</span><span class="p">(</span><span class="n">nf</span><span class="p">)</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="nb">present</span><span class="p">(</span><span class="n">gf</span><span class="p">)</span> <span class="p">)</span><span class="k">call </span><span class="n">get_generic</span><span class="p">(</span><span class="n">nf</span><span class="p">,</span><span class="n">gf</span><span class="p">)</span>
<a name="ln-5958"></a>   <span class="k">if</span><span class="p">(</span> <span class="nb">present</span><span class="p">(</span><span class="n">ng</span><span class="p">)</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="nb">present</span><span class="p">(</span><span class="n">gg</span><span class="p">)</span> <span class="p">)</span><span class="k">call </span><span class="n">get_generic</span><span class="p">(</span><span class="n">ng</span><span class="p">,</span><span class="n">gg</span><span class="p">)</span>
<a name="ln-5959"></a>   <span class="k">if</span><span class="p">(</span> <span class="nb">present</span><span class="p">(</span><span class="n">nh</span><span class="p">)</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="nb">present</span><span class="p">(</span><span class="n">gh</span><span class="p">)</span> <span class="p">)</span><span class="k">call </span><span class="n">get_generic</span><span class="p">(</span><span class="n">nh</span><span class="p">,</span><span class="n">gh</span><span class="p">)</span>
<a name="ln-5960"></a>   <span class="k">if</span><span class="p">(</span> <span class="nb">present</span><span class="p">(</span><span class="n">ni</span><span class="p">)</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="nb">present</span><span class="p">(</span><span class="n">gi</span><span class="p">)</span> <span class="p">)</span><span class="k">call </span><span class="n">get_generic</span><span class="p">(</span><span class="n">ni</span><span class="p">,</span><span class="n">gi</span><span class="p">)</span>
<a name="ln-5961"></a>   <span class="k">if</span><span class="p">(</span> <span class="nb">present</span><span class="p">(</span><span class="n">nj</span><span class="p">)</span> <span class="p">.</span><span class="nb">and</span><span class="p">.</span> <span class="nb">present</span><span class="p">(</span><span class="n">gj</span><span class="p">)</span> <span class="p">)</span><span class="k">call </span><span class="n">get_generic</span><span class="p">(</span><span class="n">nj</span><span class="p">,</span><span class="n">gj</span><span class="p">)</span>
<a name="ln-5962"></a><span class="k">contains</span>
<a name="ln-5963"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-5964"></a><span class="k">function </span><span class="n">c</span><span class="p">(</span><span class="k">generic</span><span class="p">)</span>
<a name="ln-5965"></a><span class="k">class</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="k">generic</span>
<a name="ln-5966"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">c</span>
<a name="ln-5967"></a>   <span class="k">select type</span><span class="p">(</span><span class="k">generic</span><span class="p">)</span>
<a name="ln-5968"></a>      <span class="k">type is</span> <span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">));</span> <span class="n">c</span><span class="o">=</span><span class="nb">trim</span><span class="p">(</span><span class="k">generic</span><span class="p">)</span>
<a name="ln-5969"></a>      <span class="k">class </span><span class="n">default</span>
<a name="ln-5970"></a>         <span class="n">c</span><span class="o">=</span><span class="s1">&#39;unknown&#39;</span>
<a name="ln-5971"></a>         <span class="k">stop</span> <span class="s1">&#39;get_many:: parameter name is not character&#39;</span>
<a name="ln-5972"></a>   <span class="k">end select</span>
<a name="ln-5973"></a><span class="k">end function </span><span class="n">c</span>
<a name="ln-5974"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-5975"></a><span class="k">subroutine </span><span class="n">get_generic</span><span class="p">(</span><span class="n">name</span><span class="p">,</span><span class="k">generic</span><span class="p">)</span>
<a name="ln-5976"></a><span class="k">use</span><span class="p">,</span><span class="k">intrinsic</span> <span class="kd">::</span> <span class="n">iso_fortran_env</span><span class="p">,</span> <span class="k">only</span> <span class="p">:</span> <span class="n">real64</span>
<a name="ln-5977"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>  <span class="kd">::</span> <span class="n">name</span>
<a name="ln-5978"></a><span class="k">class</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span>         <span class="kd">::</span> <span class="k">generic</span>
<a name="ln-5979"></a><span class="k">   select type</span><span class="p">(</span><span class="k">generic</span><span class="p">)</span>
<a name="ln-5980"></a>      <span class="k">type is</span> <span class="p">(</span><span class="kt">integer</span><span class="p">);</span>                        <span class="k">call </span><span class="n">get_args</span><span class="p">(</span><span class="n">name</span><span class="p">,</span><span class="k">generic</span><span class="p">)</span>
<a name="ln-5981"></a>      <span class="k">type is</span> <span class="p">(</span><span class="kt">real</span><span class="p">);</span>                           <span class="k">call </span><span class="n">get_args</span><span class="p">(</span><span class="n">name</span><span class="p">,</span><span class="k">generic</span><span class="p">)</span>
<a name="ln-5982"></a>      <span class="k">type is</span> <span class="p">(</span><span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">real64</span><span class="p">));</span>              <span class="k">call </span><span class="n">get_args</span><span class="p">(</span><span class="n">name</span><span class="p">,</span><span class="k">generic</span><span class="p">)</span>
<a name="ln-5983"></a>      <span class="k">type is</span> <span class="p">(</span><span class="kt">logical</span><span class="p">);</span>                        <span class="k">call </span><span class="n">get_args</span><span class="p">(</span><span class="n">name</span><span class="p">,</span><span class="k">generic</span><span class="p">)</span>
<a name="ln-5984"></a>      <span class="c">!x!type is (character(len=:),allocatable ::);   call get_args(name,generic)</span>
<a name="ln-5985"></a>      <span class="k">type is</span> <span class="p">(</span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">));</span>
<a name="ln-5986"></a>      <span class="k">call </span><span class="n">get_args_fixed_length</span><span class="p">(</span><span class="n">name</span><span class="p">,</span><span class="k">generic</span><span class="p">)</span>
<a name="ln-5987"></a>      <span class="k">type is</span> <span class="p">(</span><span class="kt">complex</span><span class="p">);</span>                        <span class="k">call </span><span class="n">get_args</span><span class="p">(</span><span class="n">name</span><span class="p">,</span><span class="k">generic</span><span class="p">)</span>
<a name="ln-5988"></a>      <span class="k">class </span><span class="n">default</span>
<a name="ln-5989"></a>         <span class="k">stop</span> <span class="s1">&#39;unknown type in *get_generic*&#39;</span>
<a name="ln-5990"></a>   <span class="k">end select</span>
<a name="ln-5991"></a><span class="k">end subroutine </span><span class="n">get_generic</span>
<a name="ln-5992"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-5993"></a><span class="k">end subroutine </span><span class="n">many_args</span>
<a name="ln-5994"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-5995"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-5996"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-5997"></a><span class="k">function </span><span class="n">iget</span><span class="p">(</span><span class="n">n</span><span class="p">);</span> <span class="kt">integer</span>                      <span class="kd">::</span> <span class="n">iget</span><span class="p">;</span> <span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">n</span><span class="p">;</span> <span class="k">call </span><span class="n">get_args</span><span class="p">(</span><span class="n">n</span><span class="p">,</span><span class="n">iget</span><span class="p">);</span> <span class="k">end function </span><span class="n">iget</span>
<a name="ln-5998"></a><span class="k">function </span><span class="n">rget</span><span class="p">(</span><span class="n">n</span><span class="p">);</span> <span class="kt">real</span>                         <span class="kd">::</span> <span class="n">rget</span><span class="p">;</span> <span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">n</span><span class="p">;</span> <span class="k">call </span><span class="n">get_args</span><span class="p">(</span><span class="n">n</span><span class="p">,</span><span class="n">rget</span><span class="p">);</span> <span class="k">end function </span><span class="n">rget</span>
<a name="ln-5999"></a><span class="k">function </span><span class="n">dget</span><span class="p">(</span><span class="n">n</span><span class="p">);</span> <span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">dp</span><span class="p">)</span>                <span class="kd">::</span> <span class="n">dget</span><span class="p">;</span> <span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">n</span><span class="p">;</span> <span class="k">call </span><span class="n">get_args</span><span class="p">(</span><span class="n">n</span><span class="p">,</span><span class="n">dget</span><span class="p">);</span> <span class="k">end function </span><span class="n">dget</span>
<a name="ln-6000"></a><span class="k">function </span><span class="n">sget</span><span class="p">(</span><span class="n">n</span><span class="p">);</span> <span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">sget</span><span class="p">;</span> <span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">n</span><span class="p">;</span> <span class="k">call </span><span class="n">get_args</span><span class="p">(</span><span class="n">n</span><span class="p">,</span><span class="n">sget</span><span class="p">);</span> <span class="k">end function </span><span class="n">sget</span>
<a name="ln-6001"></a><span class="k">function </span><span class="n">cget</span><span class="p">(</span><span class="n">n</span><span class="p">);</span> <span class="kt">complex</span>                      <span class="kd">::</span> <span class="n">cget</span><span class="p">;</span> <span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">n</span><span class="p">;</span> <span class="k">call </span><span class="n">get_args</span><span class="p">(</span><span class="n">n</span><span class="p">,</span><span class="n">cget</span><span class="p">);</span> <span class="k">end function </span><span class="n">cget</span>
<a name="ln-6002"></a><span class="k">function </span><span class="n">lget</span><span class="p">(</span><span class="n">n</span><span class="p">);</span> <span class="kt">logical</span>                      <span class="kd">::</span> <span class="n">lget</span><span class="p">;</span> <span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">n</span><span class="p">;</span> <span class="k">call </span><span class="n">get_args</span><span class="p">(</span><span class="n">n</span><span class="p">,</span><span class="n">lget</span><span class="p">);</span> <span class="k">end function </span><span class="n">lget</span>
<a name="ln-6003"></a>
<a name="ln-6004"></a><span class="k">function </span><span class="n">igs</span><span class="p">(</span><span class="n">n</span><span class="p">);</span> <span class="kt">integer</span><span class="p">,</span><span class="k">allocatable</span>          <span class="kd">::</span> <span class="n">igs</span><span class="p">(:);</span> <span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">n</span><span class="p">;</span> <span class="k">call </span><span class="n">get_args</span><span class="p">(</span><span class="n">n</span><span class="p">,</span><span class="n">igs</span><span class="p">);</span> <span class="k">end function </span><span class="n">igs</span>
<a name="ln-6005"></a><span class="k">function </span><span class="n">rgs</span><span class="p">(</span><span class="n">n</span><span class="p">);</span> <span class="kt">real</span><span class="p">,</span><span class="k">allocatable</span>             <span class="kd">::</span> <span class="n">rgs</span><span class="p">(:);</span> <span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">n</span><span class="p">;</span> <span class="k">call </span><span class="n">get_args</span><span class="p">(</span><span class="n">n</span><span class="p">,</span><span class="n">rgs</span><span class="p">);</span> <span class="k">end function </span><span class="n">rgs</span>
<a name="ln-6006"></a><span class="k">function </span><span class="n">dgs</span><span class="p">(</span><span class="n">n</span><span class="p">);</span> <span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">dp</span><span class="p">),</span><span class="k">allocatable</span>    <span class="kd">::</span> <span class="n">dgs</span><span class="p">(:);</span> <span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">n</span><span class="p">;</span> <span class="k">call </span><span class="n">get_args</span><span class="p">(</span><span class="n">n</span><span class="p">,</span><span class="n">dgs</span><span class="p">);</span> <span class="k">end function </span><span class="n">dgs</span>
<a name="ln-6007"></a><span class="k">function </span><span class="n">sgs</span><span class="p">(</span><span class="n">n</span><span class="p">,</span><span class="n">delims</span><span class="p">)</span>
<a name="ln-6008"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span>         <span class="kd">::</span> <span class="n">sgs</span><span class="p">(:)</span>
<a name="ln-6009"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">optional</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">delims</span>
<a name="ln-6010"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>          <span class="kd">::</span> <span class="n">n</span>
<a name="ln-6011"></a>   <span class="k">call </span><span class="n">get_args</span><span class="p">(</span><span class="n">n</span><span class="p">,</span><span class="n">sgs</span><span class="p">,</span><span class="n">delims</span><span class="p">)</span>
<a name="ln-6012"></a><span class="k">end function </span><span class="n">sgs</span>
<a name="ln-6013"></a><span class="k">function </span><span class="n">cgs</span><span class="p">(</span><span class="n">n</span><span class="p">);</span> <span class="kt">complex</span><span class="p">,</span><span class="k">allocatable</span>          <span class="kd">::</span> <span class="n">cgs</span><span class="p">(:);</span> <span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">n</span><span class="p">;</span> <span class="k">call </span><span class="n">get_args</span><span class="p">(</span><span class="n">n</span><span class="p">,</span><span class="n">cgs</span><span class="p">);</span> <span class="k">end function </span><span class="n">cgs</span>
<a name="ln-6014"></a><span class="k">function </span><span class="n">lgs</span><span class="p">(</span><span class="n">n</span><span class="p">);</span> <span class="kt">logical</span><span class="p">,</span><span class="k">allocatable</span>          <span class="kd">::</span> <span class="n">lgs</span><span class="p">(:);</span> <span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">n</span><span class="p">;</span> <span class="k">call </span><span class="n">get_args</span><span class="p">(</span><span class="n">n</span><span class="p">,</span><span class="n">lgs</span><span class="p">);</span> <span class="k">end function </span><span class="n">lgs</span>
<a name="ln-6015"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-6016"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()=</span>
<a name="ln-6017"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-6018"></a><span class="k">function </span><span class="n">ig</span><span class="p">()</span>
<a name="ln-6019"></a><span class="kt">integer</span><span class="p">,</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">ig</span><span class="p">(:)</span>
<a name="ln-6020"></a><span class="kt">integer</span>             <span class="kd">::</span> <span class="n">i</span><span class="p">,</span> <span class="n">ierr</span>
<a name="ln-6021"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">ig</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">ig</span><span class="p">)</span>
<a name="ln-6022"></a>   <span class="k">allocate</span><span class="p">(</span><span class="n">ig</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">unnamed</span><span class="p">)))</span>
<a name="ln-6023"></a>   <span class="k">do </span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">ig</span><span class="p">)</span>
<a name="ln-6024"></a>      <span class="k">call </span><span class="n">a2i</span><span class="p">(</span><span class="n">unnamed</span><span class="p">(</span><span class="n">i</span><span class="p">),</span><span class="n">ig</span><span class="p">(</span><span class="n">i</span><span class="p">),</span><span class="n">ierr</span><span class="p">)</span>
<a name="ln-6025"></a>   <span class="k">enddo</span>
<a name="ln-6026"></a><span class="k">end function </span><span class="n">ig</span>
<a name="ln-6027"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-6028"></a><span class="k">function </span><span class="n">rg</span><span class="p">()</span>
<a name="ln-6029"></a><span class="kt">real</span><span class="p">,</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">rg</span><span class="p">(:)</span>
<a name="ln-6030"></a>   <span class="n">rg</span><span class="o">=</span><span class="kt">real</span><span class="p">(</span><span class="n">dg</span><span class="p">())</span>
<a name="ln-6031"></a><span class="k">end function </span><span class="n">rg</span>
<a name="ln-6032"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-6033"></a><span class="k">function </span><span class="n">dg</span><span class="p">()</span>
<a name="ln-6034"></a><span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">dp</span><span class="p">),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">dg</span><span class="p">(:)</span>
<a name="ln-6035"></a><span class="kt">integer</span>                   <span class="kd">::</span> <span class="n">i</span>
<a name="ln-6036"></a><span class="kt">integer</span>                   <span class="kd">::</span> <span class="n">ierr</span>
<a name="ln-6037"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">dg</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">dg</span><span class="p">)</span>
<a name="ln-6038"></a>   <span class="k">allocate</span><span class="p">(</span><span class="n">dg</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">unnamed</span><span class="p">)))</span>
<a name="ln-6039"></a>   <span class="k">do </span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">dg</span><span class="p">)</span>
<a name="ln-6040"></a>      <span class="k">call </span><span class="n">a2d</span><span class="p">(</span><span class="n">unnamed</span><span class="p">(</span><span class="n">i</span><span class="p">),</span><span class="n">dg</span><span class="p">(</span><span class="n">i</span><span class="p">),</span><span class="n">ierr</span><span class="p">)</span>
<a name="ln-6041"></a>   <span class="k">enddo</span>
<a name="ln-6042"></a><span class="k">end function </span><span class="n">dg</span>
<a name="ln-6043"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-6044"></a><span class="k">function </span><span class="n">lg</span><span class="p">()</span>
<a name="ln-6045"></a><span class="kt">logical</span><span class="p">,</span><span class="k">allocatable</span>   <span class="kd">::</span> <span class="n">lg</span><span class="p">(:)</span>
<a name="ln-6046"></a><span class="kt">integer</span>               <span class="kd">::</span> <span class="n">i</span>
<a name="ln-6047"></a><span class="kt">integer</span>               <span class="kd">::</span> <span class="n">iichar</span>
<a name="ln-6048"></a><span class="kt">character</span><span class="p">,</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">hold</span>
<a name="ln-6049"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">lg</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">lg</span><span class="p">)</span>
<a name="ln-6050"></a>   <span class="k">allocate</span><span class="p">(</span><span class="n">lg</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">unnamed</span><span class="p">)))</span>
<a name="ln-6051"></a>   <span class="k">do </span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">lg</span><span class="p">)</span>
<a name="ln-6052"></a>      <span class="n">hold</span><span class="o">=</span><span class="nb">trim</span><span class="p">(</span><span class="n">upper</span><span class="p">(</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">unnamed</span><span class="p">(</span><span class="n">i</span><span class="p">))))</span>
<a name="ln-6053"></a>      <span class="k">if</span><span class="p">(</span><span class="n">hold</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="mi">1</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="s1">&#39;.&#39;</span><span class="p">)</span><span class="k">then</span>                 <span class="c">! looking for fortran logical syntax .STRING.</span>
<a name="ln-6054"></a>         <span class="n">iichar</span><span class="o">=</span><span class="mi">2</span>
<a name="ln-6055"></a>      <span class="k">else</span>
<a name="ln-6056"></a><span class="k">         </span><span class="n">iichar</span><span class="o">=</span><span class="mi">1</span>
<a name="ln-6057"></a>      <span class="k">endif</span>
<a name="ln-6058"></a><span class="k">      select case</span><span class="p">(</span><span class="n">hold</span><span class="p">(</span><span class="n">iichar</span><span class="p">:</span><span class="n">iichar</span><span class="p">))</span>         <span class="c">! check word to see if true or false</span>
<a name="ln-6059"></a>      <span class="k">case</span><span class="p">(</span><span class="s1">&#39;T&#39;</span><span class="p">,</span><span class="s1">&#39;Y&#39;</span><span class="p">,</span><span class="s1">&#39; &#39;</span><span class="p">);</span> <span class="n">lg</span><span class="p">(</span><span class="n">i</span><span class="p">)</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.</span>          <span class="c">! anything starting with &quot;T&quot; or &quot;Y&quot; or a blank is TRUE (true,yes,...)</span>
<a name="ln-6060"></a>      <span class="k">case</span><span class="p">(</span><span class="s1">&#39;F&#39;</span><span class="p">,</span><span class="s1">&#39;N&#39;</span><span class="p">);</span>     <span class="n">lg</span><span class="p">(</span><span class="n">i</span><span class="p">)</span><span class="o">=</span><span class="p">.</span><span class="n">false</span><span class="p">.</span>         <span class="c">! assume this is false or no</span>
<a name="ln-6061"></a>      <span class="k">case </span><span class="n">default</span>
<a name="ln-6062"></a>         <span class="k">call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="s2">&quot;*lg* bad logical expression for element&quot;</span><span class="p">,</span><span class="n">i</span><span class="p">,</span><span class="s1">&#39;=&#39;</span><span class="p">,</span><span class="n">hold</span><span class="p">)</span>
<a name="ln-6063"></a>      <span class="k">end select</span>
<a name="ln-6064"></a><span class="k">   enddo</span>
<a name="ln-6065"></a><span class="k">end function </span><span class="n">lg</span>
<a name="ln-6066"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-6067"></a><span class="k">function </span><span class="n">cg</span><span class="p">()</span>
<a name="ln-6068"></a><span class="kt">complex</span><span class="p">,</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">cg</span><span class="p">(:)</span>
<a name="ln-6069"></a><span class="kt">integer</span>             <span class="kd">::</span> <span class="n">i</span><span class="p">,</span> <span class="n">ierr</span>
<a name="ln-6070"></a><span class="kt">real</span><span class="p">(</span><span class="nb">kind</span><span class="o">=</span><span class="n">dp</span><span class="p">)</span>       <span class="kd">::</span> <span class="n">rc</span><span class="p">,</span> <span class="n">ic</span>
<a name="ln-6071"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">cg</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">cg</span><span class="p">)</span>
<a name="ln-6072"></a>   <span class="k">allocate</span><span class="p">(</span><span class="n">cg</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">unnamed</span><span class="p">)))</span>
<a name="ln-6073"></a>   <span class="k">do </span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">cg</span><span class="p">),</span><span class="mi">2</span>
<a name="ln-6074"></a>      <span class="k">call </span><span class="n">a2d</span><span class="p">(</span><span class="n">unnamed</span><span class="p">(</span><span class="n">i</span><span class="p">),</span><span class="n">rc</span><span class="p">,</span><span class="n">ierr</span><span class="p">)</span>
<a name="ln-6075"></a>      <span class="k">call </span><span class="n">a2d</span><span class="p">(</span><span class="n">unnamed</span><span class="p">(</span><span class="n">i</span><span class="o">+</span><span class="mi">1</span><span class="p">),</span><span class="n">ic</span><span class="p">,</span><span class="n">ierr</span><span class="p">)</span>
<a name="ln-6076"></a>      <span class="n">cg</span><span class="p">(</span><span class="n">i</span><span class="p">)</span><span class="o">=</span><span class="nb">cmplx</span><span class="p">(</span><span class="n">rc</span><span class="p">,</span><span class="n">ic</span><span class="p">,</span><span class="nb">kind</span><span class="o">=</span><span class="n">sp</span><span class="p">)</span>
<a name="ln-6077"></a>   <span class="k">enddo</span>
<a name="ln-6078"></a><span class="k">end function </span><span class="n">cg</span>
<a name="ln-6079"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-6080"></a><span class="c">! Does not work with gcc 5.3</span>
<a name="ln-6081"></a><span class="c">!function sg()</span>
<a name="ln-6082"></a><span class="c">!character(len=:),allocatable :: sg(:)</span>
<a name="ln-6083"></a><span class="c">!   sg=unnamed</span>
<a name="ln-6084"></a><span class="c">!end function sg</span>
<a name="ln-6085"></a>
<a name="ln-6086"></a><span class="k">function </span><span class="n">sg</span><span class="p">()</span>
<a name="ln-6087"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="k">allocatable</span> <span class="kd">::</span> <span class="n">sg</span><span class="p">(:)</span>
<a name="ln-6088"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">allocated</span><span class="p">(</span><span class="n">sg</span><span class="p">))</span><span class="k">deallocate</span><span class="p">(</span><span class="n">sg</span><span class="p">)</span>
<a name="ln-6089"></a>   <span class="k">allocate</span><span class="p">(</span><span class="n">sg</span><span class="p">,</span><span class="n">source</span><span class="o">=</span><span class="n">unnamed</span><span class="p">)</span>
<a name="ln-6090"></a><span class="k">end function </span><span class="n">sg</span>
<a name="ln-6091"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-6092"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()=</span>
<a name="ln-6093"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-6094"></a><span class="k">subroutine </span><span class="n">mystop</span><span class="p">(</span><span class="n">sig</span><span class="p">,</span><span class="n">msg</span><span class="p">)</span>
<a name="ln-6095"></a><span class="c">! negative signal means always stop program</span>
<a name="ln-6096"></a><span class="c">! else do not stop and set G_STOP_MESSAGE if G_QUIET is true</span>
<a name="ln-6097"></a><span class="c">! or</span>
<a name="ln-6098"></a><span class="c">! print message and stop if G_QUIET is false</span>
<a name="ln-6099"></a><span class="c">! the MSG is NOT for displaying except for internal errors when the program will be stopped.</span>
<a name="ln-6100"></a><span class="c">! It is for returning a value when the stop is being ignored</span>
<a name="ln-6101"></a><span class="c">!</span>
<a name="ln-6102"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span> <span class="kd">::</span> <span class="n">sig</span>
<a name="ln-6103"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span> <span class="kd">::</span> <span class="n">msg</span>
<a name="ln-6104"></a>   <span class="c">!x!write(*,*)&#39;MYSTOP:&#39;,sig,trim(msg)</span>
<a name="ln-6105"></a>   <span class="k">if</span><span class="p">(</span><span class="n">sig</span><span class="p">.</span><span class="n">lt</span><span class="p">.</span><span class="mi">0</span><span class="p">)</span><span class="k">then</span>
<a name="ln-6106"></a><span class="k">      if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">msg</span><span class="p">))</span><span class="k">call </span><span class="n">journal</span><span class="p">(</span><span class="s1">&#39;sc&#39;</span><span class="p">,</span><span class="n">msg</span><span class="p">)</span>
<a name="ln-6107"></a>      <span class="c">!x!stop abs(sig)</span>
<a name="ln-6108"></a>      <span class="k">stop </span><span class="mi">1</span>
<a name="ln-6109"></a>   <span class="n">elseif</span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="n">G_QUIET</span><span class="p">)</span><span class="k">then</span>
<a name="ln-6110"></a><span class="k">      stop</span>
<a name="ln-6111"></a><span class="k">   else</span>
<a name="ln-6112"></a><span class="k">      if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">msg</span><span class="p">))</span> <span class="k">then</span>
<a name="ln-6113"></a><span class="k">         </span><span class="n">G_STOP_MESSAGE</span><span class="o">=</span><span class="n">msg</span>
<a name="ln-6114"></a>      <span class="k">else</span>
<a name="ln-6115"></a><span class="k">         </span><span class="n">G_STOP_MESSAGE</span><span class="o">=</span><span class="s1">&#39;&#39;</span>
<a name="ln-6116"></a>      <span class="k">endif</span>
<a name="ln-6117"></a><span class="k">      </span><span class="n">G_STOP</span><span class="o">=</span><span class="n">sig</span>
<a name="ln-6118"></a>      <span class="c">!x!write(*,*)&#39;G_STOP:&#39;,g_stop,trim(msg)</span>
<a name="ln-6119"></a>   <span class="k">endif</span>
<a name="ln-6120"></a><span class="k">end subroutine </span><span class="n">mystop</span>
<a name="ln-6121"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-6122"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()=</span>
<a name="ln-6123"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-6124"></a><span class="k">function </span><span class="n">atleast</span><span class="p">(</span><span class="n">line</span><span class="p">,</span><span class="n">length</span><span class="p">,</span><span class="n">pattern</span><span class="p">)</span> <span class="k">result</span><span class="p">(</span><span class="n">strout</span><span class="p">)</span>
<a name="ln-6125"></a>
<a name="ln-6126"></a><span class="c">! ident_40=&quot;@(#)M_strings::atleast(3f): return string padded to at least specified length&quot;</span>
<a name="ln-6127"></a>
<a name="ln-6128"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>                <span class="kd">::</span> <span class="n">line</span>
<a name="ln-6129"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>                         <span class="kd">::</span> <span class="n">length</span>
<a name="ln-6130"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="k">optional</span>       <span class="kd">::</span> <span class="n">pattern</span>
<a name="ln-6131"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="nb">max</span><span class="p">(</span><span class="n">length</span><span class="p">,</span><span class="nb">len</span><span class="p">(</span><span class="nb">trim</span><span class="p">(</span><span class="n">line</span><span class="p">))))</span> <span class="kd">::</span> <span class="n">strout</span>
<a name="ln-6132"></a><span class="k">if</span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">pattern</span><span class="p">))</span><span class="k">then</span>
<a name="ln-6133"></a><span class="k">   </span><span class="n">strout</span><span class="o">=</span><span class="n">line</span><span class="o">//</span><span class="nb">repeat</span><span class="p">(</span><span class="n">pattern</span><span class="p">,</span><span class="nb">len</span><span class="p">(</span><span class="n">strout</span><span class="p">)</span><span class="o">/</span><span class="nb">len</span><span class="p">(</span><span class="n">pattern</span><span class="p">)</span><span class="o">+</span><span class="mi">1</span><span class="p">)</span>
<a name="ln-6134"></a><span class="k">else</span>
<a name="ln-6135"></a><span class="k">   </span><span class="n">strout</span><span class="o">=</span><span class="n">line</span>
<a name="ln-6136"></a><span class="k">endif</span>
<a name="ln-6137"></a><span class="k">end function </span><span class="n">atleast</span>
<a name="ln-6138"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-6139"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()=</span>
<a name="ln-6140"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-6141"></a><span class="k">subroutine </span><span class="n">locate_key</span><span class="p">(</span><span class="k">value</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-6142"></a>
<a name="ln-6143"></a><span class="c">! ident_41=&quot;@(#)M_CLI2::locate_key(3f): find PLACE in sorted character array where VALUE can be found or should be placed&quot;</span>
<a name="ln-6144"></a>
<a name="ln-6145"></a><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span>             <span class="kd">::</span> <span class="k">value</span>
<a name="ln-6146"></a><span class="kt">integer</span><span class="p">,</span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span>                     <span class="kd">::</span> <span class="n">place</span>
<a name="ln-6147"></a><span class="kt">integer</span>                                 <span class="kd">::</span> <span class="n">ii</span>
<a name="ln-6148"></a>   <span class="k">if</span><span class="p">(</span><span class="nb">len_trim</span><span class="p">(</span><span class="k">value</span><span class="p">).</span><span class="n">eq</span><span class="p">.</span><span class="mi">1</span><span class="p">)</span><span class="k">then</span>
<a name="ln-6149"></a>      <span class="c">!x!ii=findloc(shorts,value,dim=1)</span>
<a name="ln-6150"></a>      <span class="n">ii</span><span class="o">=</span><span class="nb">maxloc</span><span class="p">([</span><span class="mi">0</span><span class="p">,</span><span class="nb">merge</span><span class="p">(</span><span class="mi">1</span><span class="p">,</span> <span class="mi">0</span><span class="p">,</span> <span class="n">shorts</span><span class="p">.</span><span class="n">eq</span><span class="p">.</span><span class="k">value</span><span class="p">)],</span><span class="nb">dim</span><span class="o">=</span><span class="mi">1</span><span class="p">)</span>
<a name="ln-6151"></a>      <span class="k">if</span><span class="p">(</span><span class="n">ii</span><span class="p">.</span><span class="n">gt</span><span class="p">.</span><span class="mi">1</span><span class="p">)</span><span class="k">then</span>
<a name="ln-6152"></a><span class="k">         </span><span class="n">place</span><span class="o">=</span><span class="n">ii</span><span class="o">-</span><span class="mi">1</span>
<a name="ln-6153"></a>      <span class="k">else</span>
<a name="ln-6154"></a><span class="k">         call </span><span class="n">locate</span><span class="p">(</span><span class="n">keywords</span><span class="p">,</span><span class="k">value</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-6155"></a>      <span class="k">endif</span>
<a name="ln-6156"></a><span class="k">   else</span>
<a name="ln-6157"></a><span class="k">      call </span><span class="n">locate</span><span class="p">(</span><span class="n">keywords</span><span class="p">,</span><span class="k">value</span><span class="p">,</span><span class="n">place</span><span class="p">)</span>
<a name="ln-6158"></a>   <span class="k">endif</span>
<a name="ln-6159"></a><span class="k">end subroutine </span><span class="n">locate_key</span>
<a name="ln-6160"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-6161"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-6162"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-6163"></a><span class="k">end module </span><span class="n">M_CLI2</span>
<a name="ln-6164"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-6165"></a><span class="c">!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!</span>
<a name="ln-6166"></a><span class="c">!===================================================================================================================================</span>
<a name="ln-6167"></a><span class="c">! REVISION:  nvfortran does not support real128 from iso_fortran_env x86_64 GNU/Linux</span>
<a name="ln-6168"></a><span class="c">!            nvfortran 20.7-0 LLVM 64-bit target on x86-64 Linux -tp nehalem</span>
<a name="ln-6169"></a><span class="c">! &lt; !NVFORTRAN-S-0000-Internal compiler error. size_of: attempt to get size of assumed size character       0  (M_CLI2.f90: 2012)</span>
<a name="ln-6170"></a><span class="c">! &lt; !  0 inform,   0 warnings,   1 severes, 0 fatal for get_anyarray_cc</span>
<a name="ln-6171"></a><span class="c">! Changed</span>
<a name="ln-6172"></a><span class="c">!       allocate(character(len=*)::strings(0))</span>
<a name="ln-6173"></a><span class="c">! to</span>
<a name="ln-6174"></a><span class="c">!       strings=[character(len=len(strings)) ::]</span>
<a name="ln-6175"></a><span class="c">!===================================================================================================================================</span>
</pre></div>

    </section>
    </div>
  </div>

  
    <hr>    
    </div> <!-- /container -->
    <footer>
      <div class="container">
      <div class="row">
        <div class="col-xs-6 col-md-4"><p>&copy; 2022 
                                          </p></div>
        <div class="col-xs-6 col-md-4 col-md-push-4">
          <p class="text-right">
            Documentation generated by 
            <a href="https://github.com/cmacmackin/ford">FORD</a>
             on 2022-06-08 21:13  
          </p>
        </div>
        <div class="col-xs-12 col-md-4 col-md-pull-4"><p class="text-center"> M_CLI2 was developed by John S. Urban</p></div>
      </div>
      <br>
      </div> <!-- /container -->    
    </footer>

    <!-- Bootstrap core JavaScript
    ================================================== -->
    <!-- Placed at the end of the document so the pages load faster -->
<!--
    <script src="https://ajax.googleapis.com/ajax/libs/jquery/1.11.1/jquery.min.js"></script>
-->
    <script src="../js/bootstrap.min.js"></script>
    <!-- IE10 viewport hack for Surface/desktop Windows 8 bug -->
    <script src="../js/ie10-viewport-bug-workaround.js"></script>

    <!-- MathJax JavaScript
    ================================================== -->
    <!-- Placed at the end of the document so the pages load faster -->
    <script type="text/x-mathjax-config">
      MathJax.Hub.Config({
        TeX: { extensions: ['AMSmath.js','AMSsymbols.js','noErrors.js','noUndefined.js'], equationNumbers: { autoNumber: 'AMS' } },
        jax: ['input/TeX','input/MathML','output/HTML-CSS'],
        extensions: ['tex2jax.js','mml2jax.js','MathMenu.js','MathZoom.js']
      });
    </script>
    
    <script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.1/MathJax.js?config=TeX-AMS-MML_HTMLorMML"></script>
    
    
    <script src="../tipuesearch/tipuesearch_content.js"></script>
    <script src="../tipuesearch/tipuesearch_set.js"></script>
    <script src="../tipuesearch/tipuesearch.js"></script>
    
    
  </body>
</html>